|
才两个工作簿,数据少了点:
Sub gj23w98()
Dim br(1 To 100000, 1 To 10)
tms = Timer
p = ThisWorkbook.Path & "\"
f = Dir(p & "*.xls*")
Application.ScreenUpdating = False
Do While f <> ""
If f <> ThisWorkbook.Name Then
Set wb = Workbooks.Open(p & f)
ar = Sheets(1).[a1].CurrentRegion
wb.Close False
For i = 5 To UBound(ar)
If Len(ar(i, 1)) Then
m = m + 1
For j = 1 To 10
br(m, j) = ar(i, j)
Next
End If
Next
End If
f = Dir
Loop
If m Then
[a1].CurrentRegion.Offset(6).ClearContents
[a7].Resize(m, 10) = br
[a7].Resize(m, 10).Borders.LineStyle = 1
End If
Application.ScreenUpdating = True
MsgBox "汇总完成!" & "用时:" & Format(Timer - tms, "0.00") & "秒", 64
End Sub |
|