本帖最后由 chrisfang 于 2013-9-23 08:51 编辑
实例4：通用多文件条件汇总
http://club.excelhome.net/thread-151855-1-1.html
Sub Multifile()
Dim sName As String , Sql As String ,strTbl As String , a() As String
Dim intTblCnt As Integer, intColCnt As Integer, t As Integer, c As Integer, f As Integer, Count As Integer
Dim Filename As Variant '预先无法知道此数组大小，因预先无法知道要打开的文件数
intColCnt = Cells(1, 256).End(xlToLeft).Column '要查找的字段个数
ReDim a(intColCnt + 2) ‘确定数组的大小,此数组用于存放要查找的字段名
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 = New ADODB.Connection ‘（1）
With cn ‘（2）
.Provider = "Microsoft.Jet.OLEDB.4.0"
.ConnectionString = "Data Source=" & fn & ";Extended Properties=Excel 8.0;"
.Open
End With
intTblCnt = ActiveWorkbook.Sheets.Count ‘当前打开文件中的工作表数
For t = 1 To intTblCnt '对文件中的表遍历
Count = 0 '用于统计不被当前表包含的汇总字段的个数
ActiveWorkbook.Sheets(t). Activate ‘激活当前遍历的表
Sql = "" ‘准备循环产生 sql 查询字符串
intFldsCnt = ActiveWorkbook.Sheets(t).Cells(1, 256).End(xlToLeft).Column
‘当前表第一行的列数，若为 0，则为空表，Sql 会保持为空 “”
strTbl = ActiveWorkbook.Sheets(t).Name ‘当前表的名称
For c = 1 To intColCnt '对于表中每个要汇总的字段进行遍历
sign = 0 ‘用此标识 表中是否存在要汇总的字段
a(c) = ThisWorkbook.Sheets(1).Cells(1, c).Value ‘将要汇总的字段名存入a中
a(c + 1) = ThisWorkbook.Sheets(1).Cells(1, c + 1).Value ‘要汇总的下一个字段存入 a 的下一个元素中
For f = 1 To intFldsCnt '遍历表中的每一列
With ActiveWorkbook.Sheets(t) ‘对于当前表
If Cells(1, f) = a(c) Then '若字段存在
sign = 1 ‘将标志置为 1
Sql = Sql & a(c) & "," ‘逐次连接字段名
End If
End With
Next '遍历表中的列结束
If sign = 0 Then '若表中不存在此汇总字段
Sql = Sql & a(c + 1) & "," '则用下一个汇总字段代替
Count = Count + 1 ‘不被当前表包含的汇总字段的个数加 1
End If
Next '对于表中要查找的字段遍历结束
‘若要汇总的字段为“借款单位”、“借款人”，则以上遍历结束后，若存在这两个字段，则连接字段名表为
‘ 借款单位,借款人,
‘在查询时，字段名表位于Select 与 from 之间，字段名之间用逗号分隔，而最后一个字段名后无逗号，所以需要将它去掉，可采用以下方法：
Sql = Left(Sql, Len(Sql) - 1) ‘Len 函数得到字符串的长度，Left 函数对字符串从左边截取第二个参数所指定长度的字符串，如 字符串长度为 8 ，只要从左边截取 7 个字符，则新字符串中不再包含最后一个字符
If Len(Sql) = 0 Or Count = intColCnt Then
‘假如连接字符串为空，说明当前表为空表
‘或者不被当前表包含的汇总字段的个数等于汇总字段的总数，说明当前表不包含任何汇总字段
GoTo Label1 ‘则进行下一个表的遍历
End If
‘否则，说明存在汇总字段，需进行汇总
Sql = "Select " & Sql & " FROM [" & strTbl & "$] " ‘(3)
ThisWorkbook.Sheets(1).Cells(65535,1).End(xlUp).Offset(1,0).CopyFromRecordset cn.Execute(Sql) ‘（4）
‘其中 Offset(行数,列数) 可进行偏移
‘其中Cells(65535, 1).End(xlUp) 为第 1 列最下面的有数据的单元格，如果是 A30
‘则 Cells(65535, 1).End(xlUp).Offset(1, 0) 为向下偏移一行的单元格，则为 A31
‘所以每次循环后得到的汇总表总是接在上一次显示结果的后面显示，故能将每次从不同文件、不同表中得到的
‘汇总结果依次显示在一个表中
Label1:
Next '对文件中的表遍历结束
cn.Close ‘关闭当前文件连接 ‘（5）
Workbooks(sName).Close False ‘关闭当前文件，不保存
Next '文件遍历结束
Set cn = Nothing ‘（6）
End Sub
实例5：
http://club.excelhome.net/thread-159850-3-1.html
Sql = "Select 商品号,min(价格) from [A$] where 性质='正常' and (商品号= ‘129 002 003’ or商品号= ‘128 002 003’) group by 商品号"
查找出“商品号”字段值为 129 002 003 或者 128 002 003 ，并且“性质”字段值为“正常”的记录，在这些记录中继续找出“价格”字段值最小的记录，返回该记录的 商品号、价格 的字段值
实例6：
http://club.excelhome.net/thread-158259-4-1.html
Sql = "select 品号,品类,sum(数量),sum(金额),'','','','','','',类型 from [明细表$] where month(日期)=" & Month(Range(“J2”)) & " group by 品号,类型,品类 order by 品号,类型 desc"
其中：
Month 函数可从包含年月日的日期中取出月份来，故以上查询为：
查询月份与 J2 单元格中的月份相同的记录，按照 品号、类型、品类 分类，以 品号、类型 字段作为第一和第二关键字进行排序，其中 类型字段为降序（desc）排列，
按照字段名表指定的顺序：品号,品类,sum(数量),sum(金额),'','','','','','',类型
进行显示，其中“数量”、“金额”字段显示的是符合条件的记录按“品号”分类的数值和， 而“品号”、“品类”、“类型”字段，显示的是符合条件的记录在表中的原值，显示时“金额”字段与类型字段之间相隔 6 个字段的距离，在显示区域的这 6 列为空白；在字段名表中不显示的字段用两个单引号（''）代替，并仍然用逗号与其它字段名相隔。
[此贴子已经被作者于2006-8-20 21:28:23编辑过] |
[复制链接]
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2006-4-10 00:04
楼主
