使用 ADO-SQL 处理 EXCEL 文件的程序架构（实例注释）

来生缘

QEE用大佬,你献的花全凋谢了.看我的[em23][em23][em23][em23]

爱歌学习兄弟,总结完以后,摆个WORD版的上来好不好?偶系懒人。我在这里多谢你先哈

爱歌学习

哈，word版在一楼啊，那我把它挪到最上面

爱歌学习

新增在三楼

layouter

ding

爱歌学习

新增： 实例8：使用 Union 进行多表查询，并对月份表进行汇总 （三楼）

hxl2005

好好啊

wish2004

好东西，最近想了解一下sql大法的，学习了

学习分享

正在学着呢，才刚看到有这么好的东西，支持版主发贴！收录了，慢慢啃一下！

爱歌学习

实例9：使用 IMEX=1 对于数据类型不一致的列强制为文本型处理且自动去除链接 （第3页22楼）（2006年4月18日新增）
实例10：对于大数量文件，不打开源文件及目标文件而进行重新分类（第4页39楼）（2006年6月6日新增）
实例11：ADO批量处理ACCESS数据库   （第5页42楼）（2006年6月14日新增）
实例12：查询ACCESS后的结果直接产生新文件（第5页42楼）
实例13：批量导出DBF为对应Excel文件（第5页42楼）
实例14：不打开文件而引用单列、单行、某个单元格、横向单元格的和、纵向单元格的和（第6页51楼）
实例15：格式相同的多文件多表去除空行后顺序汇入一张表中（第7页62楼）
实例16 ：替代 VLOOUP、SUMPRODUCT 的VBA编码－多重 Join 的使用（第7页69楼）
实例17：列出库中欠缺编号-NOT IN 的应用（第8页71楼）
实例18：用 Union 从字段不相同的两个 Access 表中筛选记录后按相似字段排序（第11页102楼）
实例19：用 Union 进行忽略某种数值的汇总（第11页104楼）
实例20：用ADO进行联动选择填写单据－ADO 与 LISTBOX（第11页107楼）
实例21：多字段分类汇总－类数据透视表格式的汇总－加载宏（第12页113楼）
实例22：<font color="#000000" size="3">ADO-SQL语句对照使用</font>（第12页117楼）
实例23：Transform 的使用－若要将某一字段的分类作为列标题，可使用 Transform 来实现（第13页128楼）
实例24：使用 ADO 在 Excel 中与 SQLSERVER 进行数据传输（第13页129楼）
使用 ADO 连接文件自身时出现的问题及应对</font>（2007年1月28日新增）
实例9：使用 IMEX=1 对于数据类型不一致的列强制为文本型处理且自动去除链接
http://club.excelhome.net/viewthread.php?tid=189647&extra=&page=2#529755
Sub totall()
Dim sName As String, Sql As String, strTbl As String
Dim intTblCnt As Integer, rng As Range
Dim Filename As Variant   '预先无法知道此数组大小，因预先无法知道要打开的文件数
Filename = Application.GetOpenFilename("Microsoft Office Excel Files (*.xls), *.xls", , "请选取文件", , MultiSelect:=True)  
'打开选取文件对话框，将选取的各文件全路径名存于 Filename 数组中
If Not IsArray(Filename) Then Exit Sub      '如果未选取文件，则退出程序
For Each fn In Filename  '在整个选择的范围内循环, fn 为 Filename 数组中的一项，是其中的一个全路径名
Application.ScreenUpdating = False        '不显示处理过程
sName = Dir(fn)                            '从文件的全路径中取出文件名
Workbooks.Open fn                          '打开文件
Set cn = CreateObject("ADODB.Connection")               '（1）
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel 8.0;IMEX=1;';Data Source=" & fn    '（2）
'此处 IMEX=1 对于数据类型不一致的列强制为文本型处理  
        For Each sh In ActiveWorkbook.Worksheets     '对文件中的表遍历
            strTbl = sh.Name                         '当前表的名称
            Sql = "Select * FROM [" & strTbl & "$a3:ah100] "       '(3)
            With ThisWorkbook.Sheets(strTbl)
                .[b65536].End(xlUp).Offset(2, -1).CopyFromRecordset cn.Execute(Sql)     '（4）
                '以下将文本型数值转回数值型
                Set rng = .Range(.[AJ2], .Range("AJ2" & [a65536].End(xlUp).Row)) '临时区域
                rng.FormulaR1C1 = "=VALUE(RC[-3])" '设公式将文本区域数值取出
                rng.Copy
                .[ag2].PasteSpecial Paste:=xlPasteValues  '粘贴数值
                rng.Clear '清除临时区域
            End With
        Next
        cn.Close                                      '关闭当前文件连接    '（5）
        Workbooks(sName).Close False                  '关闭当前文件，不保存
    Next
    Sheet3.Activate
    Set cn = Nothing                                           '（6）
    Application.ScreenUpdating = True
End Sub

[此贴子已经被作者于2007-2-27 20:58:52编辑过]

[ 本帖最后由 爱歌学习 于 2010-7-22 08:32 编辑 ]

爱歌学习

实例7：改进版：将查询结果保存在临时对象中，而不再使用工作表单元格作为临时区域
wPK5RvQK.rar (46.93 KB, 下载次数: 517)

2006-4-19 22:21 上传

点击文件名下载附件
使用 ADO-SQL 处理 EXCEL 文件的程序架构（实例注释）

Sub notopenfile2()
    Dim Sql$, line&, lines&, i&, i1&, m%, daycolumn%, d%
    Dim rng As Range  
    'Application.ScreenUpdating = False
    Set Conn = CreateObject("adodb.connection")    '（1）
    Conn.Open "provider=microsoft.jet.oledb.4.0;extended properties=excel 8.0;data source=" & ThisWorkbook.Path & "\Worktime.xls"     '连接同一工作簿下的另一文件 '（2）
    For m = 1 To 12                                           '遍历12个月
        Sql = "Select Whour,Line,Shift,Date from [worktime$] where month(Date)=" & m '找出月份与当前遍历月份相同的记录 （3）
        Set temp = Conn.Execute(Sql)
  '将查询结果保存在临时对象中，而不再使用工作表单元格作为临时区域  （4）
        If Not temp.EOF Then           '如果记录不为空
            Sheets(1).Copy after:=Sheets(Sheets.Count)             '在最后产生一个新表
            Sheets(Sheets.Count).Name = m & "月"                     '将新表命名为当前遍历的月份
            For d = 1 To 31                                     '遍历31天
                daycolumn = d + 2                              '31个日单元格所在列号
                Sql = "Select sum(Whour),iif(asc(Line)<65,'Line' & Line,Line),Shift from [worktime$]" & _
    " where month(Date)=" & m & "and day(Date)=" & Cells(1, daycolumn) & " group by Line,Shift" '（3）
'按日汇总，其中 day 函数将日期中的日取出，而 asc(Line)<65 ，可判断首字符是否为字母，字母的ASCII 码介于 65～90，97～122之间
                Set temp = Conn.Execute(Sql)  
'将查询结果保存在临时对象中，而不再使用工作表单元格作为临时区域  （4）
'当前规划好的表中纵列已列好了规定项目，而查询出来的项目与规定的顺序并不相符，所以先将查询出的结果放在临时对象中，准备进行下面的按指定位置填充的步骤
                Do While Not temp.EOF    '遍历查询结果的每一条记录
                    For i1 = 2 To [a65536].End(xlUp).Row - 1                '与规定项目逐一比较
                        If tempday.Fields(1) = Cells(i1, 1) And tempday.Fields(2) = Cells(i1, 2) Then   '如果两相匹配
                            Cells(i1, daycolumn) = tempday.Fields(0)     '该项目得到记录值
                            Exit For                            '退出该项目遍历，开始下一记录的匹配
                        End If
                    Next
                    tempday.MoveNext  '记录指针前移到下一条记录
                Loop
            Next
             '如果已遍历到最后一天,则需设置最后一列的横向求和公式及最后一行纵向求和公式,
             '若事先设好公式,会极大地影响程序运行速度,故求和公式放至结果出来后再加入
            [AH2:AH102].FormulaR1C1 = "=SUM(RC[-31]:RC[-1])"
            [C102:AG102].FormulaR1C1 = "=SUM(R[-100]C:R[-1]C)"
        End If
    Next
    Conn.Close              '（5）
Set Conn = Nothing      '（6）
Set temp = Nothing
Application.ScreenUpdating = True
End Sub

[此贴子已经被作者于2006-9-27 20:08:04编辑过]