|
楼主 |
发表于 2012-4-25 22:20
|
显示全部楼层
搜索一下SQL或ADO,学习一下SQL语句的基本知识,否则即使注释了也不好理解:- Sub Macro2() '简易,速度较快,只适用已知“每个工作簿都有3个格式相同的工作表,名称分别是1部门、2部门和3部门”
- tt = Timer
- Dim cnn As Object
- Dim SQL$, MyPath$, MyFile$, a, arr(), i%, ii%, j%, t$, m%
- t = [c2] '要查询的姓名
- a = Array("1部门$a3:f65536", "2部门$a3:f65536", "3部门$a3:f65536") '3个工作表的数据区
- Application.ScreenUpdating = False '关闭屏幕刷新
- ActiveSheet.UsedRange.Offset(3).ClearContents '清除原数据
- MyPath = ThisWorkbook.Path & "" '路径
- MyFile = Dir(MyPath & "*.xls") '利用dir函数查找.xls文件
- Do While MyFile <> "" '查到文件
- If MyFile <> ThisWorkbook.Name Then '不是本工作簿
- m = m + 1 '计数
- ReDim Preserve arr(1 To m) '重新定义动态数组
- arr(m) = MyFile '数组储存文件名
- End If
- MyFile = Dir() '继续调用dir函数查找
- Loop '循环
- Set cnn = CreateObject("adodb.connection") '创建connection对象
- cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties=Excel 8.0;Data Source=" & MyPath & arr(1) '连接第一个工作簿
- For i = 1 To m Step 16 '逐个文件,16个文件为一组(48个工作表,不超过ADO最大联合查询49个工作表的限制)
- SQL = "" '设置SQL语句初值(48个工作表使用一个SQL语句)
- For ii = i To i + 15 '16个文件为一组
- If ii > m Then Exit For '如果文件数超过实际文件数m则退出循环
- For j = 0 To 2 '逐个工作簿
- If Len(SQL) Then SQL = SQL & " union all " '使用union all把每个工作表的SQL语句连起来
- SQL = SQL & "select 序号,姓名,客户号,合同号,档案编号,期限,'" & Replace(arr(ii), ".xls", "") & "','" & Left(a(j), 3) & "' from [Excel 8.0;Database=" & MyPath & arr(ii) & "].[" & a(j) & "] where 姓名='" & t & "'"
- Next
- Next
- [a65536].End(xlUp).Offset(1).CopyFromRecordset cnn.Execute(SQL) '48个工作表复制一次查询数据
- Next
- cnn.Close '关闭connection连接
- Set cnn = Nothing '释放内存
- Application.ScreenUpdating = True '启动屏幕刷新
- MsgBox Timer - tt
- End Sub
-
复制代码 |
|