|
|
Sub 多表查询()
Application.ScreenUpdating = False
Dim ar As Variant
Dim br()
ReDim br(1 To 100000, 1 To 7)
lj = ThisWorkbook.Path & "\"
With Sheet1
zd = .[e1] & "|" & .[f1]
f = Dir(lj & "*.xlsb")
Do While f <> ""
If f <> ThisWorkbook.Name Then
Set wb = Workbooks.Open(lj & f, 0)
For Each sh In wb.Worksheets
If sh.Index <= 2 Then
ar = sh.[a1].CurrentRegion
For i = 1 To UBound(ar)
If Trim(ar(i, 5)) <> "" And Trim(ar(i, 6)) <> "" Then
zf = Trim(ar(i, 5)) & "|" & Trim(ar(i, 6))
If zf = zd Then
n = n + 1
For j = 1 To 6
br(n, j) = ar(i, j)
Next j
br(n, 7) = Split(wb.Name, ".")(0)
End If
End If
Next i
End If
Next sh
wb.Close False
End If
f = Dir
Loop
If n = "" Then MsgBox "没有符合条件的数据！": End
.UsedRange.Offset(2) = Empty
.[a3].Resize(n, UBound(br, 2)) = br
End With
Application.ScreenUpdating = True
MsgBox "ok!"
End Sub
|
|
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2023-5-31 09:12
楼主
