|
|
Sub 多条件多工作簿多工作表查询()
StartTime = Timer
Application.ScreenUpdating = False
Dim str$, str1$
Dim ran As Range
With ThisWorkbook.Sheets("查询")
Set ran = .Range("A5:L25000")
ran = ""
brr = .Range("A5:L25000")
crr = .Range("A2:L2")
End With
MyFile = Dir(ThisWorkbook.Path & "\分表\*.*") '取得分表文件夹下任意一个文件名
Do '循环文件夹里的文件
Set Wb = GetObject(ThisWorkbook.Path & "\分表\" & MyFile) '在后台打开工作簿且赋值给变量Wb
For x = 1 To Wb.Sheets.Count '循环打开的工作簿里的工作表
If Application.CountA(Wb.Sheets(x).UsedRange) > 1 Then
Arr = Wb.Sheets(x).[a3].CurrentRegion
For j = 2 To UBound(Arr)
For i = 1 To UBound(crr, 2)
If crr(1, i) <> "" Then
str = str & "*" & UCase（crr(1, i)） & "*"
str1 = str1 & Arr(j, i)
End If
Next i
If str1 Like str And str <> "" Then
mm = mm + 1
For m = 1 To UBound(Arr, 2)
brr(mm, m) = Arr(j, m)
brr(mm, 11) = MyFile
brr(mm, 12) = Wb.Sheets(x).Name
Next m
End If
str1 = ""
str = ""
Next j
End If
Next x
Wb.Close True '关闭wb工作簿
MyFile = Dir '第二次赋值不要参数,且自动找到下一个工作簿
Loop While MyFile <> ""
ThisWorkbook.Sheets("查询").Columns("b:z").NumberFormat = "@"
ran = "": ran = brr
TimeOne = Format(Timer - StartTime, "0.00000") & "秒"
Application.ScreenUpdating = True
MsgBox "查询时间：" & TimeOne
End Sub
|
|
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2018-8-19 09:53
楼主
