多工作簿查询-数组法

wmqz.130

论坛中对于多工作簿查询的求助很多，我以此实例来给大家分享一种解决办法。代码不见的有多好，还请广大坛友斧正！！！
这个实例是同一文件夹下的多工作簿查询，如果大家要实现本文件夹及子文件夹的查询，道理基本相同，请大家结合http://club.excelhome.net/thread-1165866-1-1.html这个帖子搜索文件夹及子文件夹就可以了。

多工作簿查询-数组法.zip (1.15 MB, 下载次数: 155)

2018-3-2 12:03 上传

点击文件名下载附件

1. Public Sub 查询()
   
2. Application.ScreenUpdating = False
   
3. sPath = ThisWorkbook.Path & "" '获取本工作簿所在文件夹
   
4. Dim vFill()
   
5. sFile = Dir(sPath & "*.xls*")
   
6. pm = [a2].Value
   
7. pp = [b2].Value
   
8. xh = [c2].Value
   
9. gg = [d2].Value
   
10. n = 0
    
11. Do While sFile <> ""
    
12. If sFile <> ThisWorkbook.Name Then
    
13.    With Workbooks.Open(sPath & sFile)  '打开工作簿sFile
    
14.     For i = 1 To 3
    
15.    
    
16.        lr = .Sheets(i).[a65536].End(xlUp).Row
    
17.        adate = .Sheets(i).Range("a2:cj" & lr) '将第一个表的所有已用单元格的数值赋值给数组
    
18.        For j = 1 To UBound(adate)
    
19.          tj = True
    
20.         
    
21.          If pm <> "" Then tj = (adate(j, 11) Like "*" & pm & "*") And tj
    
22.          If pp <> "" Then tj = (adate(j, 12) Like "*" & pp & "*") And tj
    
23.          If xh <> "" Then tj = (adate(j, 13) Like "*" & xh & "*") And tj
    
24.          If gg <> "" Then tj = (adate(j, 14) Like "*" & gg & "*") And tj
    
25.          
    
26.             If tj Then
    
27.             n = n + 1
    
28.             ReDim Preserve vFill(1 To 89, 1 To n)
    
29.                For nCol = 1 To 88
    
30.                   vFill(nCol, n) = adate(j, nCol) '复制符合条件的一行数据到查询数据数组最后一行上
    
31.                   If nCol = 88 Then vFill(89, n) = sFile & "" & .Sheets(i).Name
    
32.                Next
    
33.             End If
    
34.        Next
    
35.     Next
    
36.     .Close False '关闭工作簿sFile
    
37.     End With
    
38.    End If
    
39.    sFile = Dir
    
40. Loop
    
41. ThisWorkbook.Activate '本工作簿激活为使用状态
    
42.     With Sheets("汇总") '对”汇总“表进行操作
    
43.     .[a4:ck65536].ClearContents
    
44.     If n > 0 Then
    
45.     .[a4].Resize(n, 89) = Application.WorksheetFunction.Transpose(vFill)
    
46.     End If
    
47.     End With
    
48. Application.ScreenUpdating = True
    
49. End Sub
    

复制代码

zpj415263

您好。首先谢谢你的程序
其次我有个问题就是如果提取包含目前“工作簿查询汇总01”中除了汇总汇总表意外的其他表如何用呢？
就好比我吧你文件夹下那些文件全部放到“工作簿查询汇总01”中的其他工作表中？

wmqz.130

zpj415263 发表于 2018-3-5 09:55
您好。首先谢谢你的程序
其次我有个问题就是如果提取包含目前“工作簿查询汇总01”中除了汇总汇总表意外的 ...

可以办的到，如你所说就更简单了，你这相当于多工作表汇总。

让程序遍历除了汇总的其他所有表就行。

zpj415263

大师按照你的我已经可以做出同文档中固定工作栏的提取。但是目前是提取内容A和B是且的关系。如何改成“或”关系呢？ 工作簿查询汇总01.rar (46.04 KB, 下载次数: 14)

2018-3-5 17:01 上传

点击文件名下载附件