|
“多工作簿查询”的程序执行出来的结果是错的啊,不过我写出来了,这是我写的,继续学习!
Option Explicit
Sub 多工作簿汇总()
Dim i%, j%, m&, path1$, wbname$, name$, arr, arr2(1 To 6)
Dim wb As Workbook, wb0 As Workbook, ws As Worksheet
Set wb = ThisWorkbook
name = wb.Worksheets(2).Cells(1, 1)
path1 = ThisWorkbook.path & "\分表\"
wbname = Dir(path1 & "*.xlsx")
Do While wbname <> ""
Set wb0 = Workbooks.Open(path1 & wbname)
For Each ws In wb0.Worksheets
arr = ws.Range("a1").CurrentRegion
For i = 1 To UBound(arr)
If arr(i, 1) = name Then
For j = 1 To UBound(arr, 2)
arr2(j) = arr(i, j)
Next j
wb.Worksheets(2).Cells(Cells.Rows.Count, 2).End(xlUp).Offset(1, 0).Resize(1, UBound(arr2)) = arr2
End If
Next i
Next ws
wb0.Close False
wbname = Dir
Loop
'可再作一下按月份排序
End Sub
|
|