|
代码如下。。。。
Sub test() 'by quqiyuan 11-20
t = Timer
Dim MyPath$, MyName$, sh As Worksheet, sht As Worksheet
Dim n%, lr%, r%, i%, j%
Application.ScreenUpdating = False
Set sh = ActiveSheet
MyPath = ThisWorkbook.Path & "\明细\"
MyName = Dir(MyPath & "*.xls*")
lr = sh.Cells(sh.Rows.Count, 5).End(xlUp).Row
sh.Range("e16:x" & lr).Clear
ReDim brr(1 To 100000, 1 To 20)
m = 0
Do While MyName <> ""
If MyName <> ThisWorkbook.Name Then
With Workbooks.Open(MyPath & MyName, 0)
For Each sht In .Sheets
n = sht.Cells(sht.Rows.Count, 7).End(xlUp).Row
If n > 15 Then
r = n - 1
arr = sht.[e16].Resize(n - 15, 18)
For i = 1 To UBound(arr)
If arr(i, 2) <> Empty Then
m = m + 1
brr(m, 1) = MyName
brr(m, 2) = sht.Name
For j = 1 To 18
brr(m, j + 2) = arr(i, j)
Next
End If
Next
End If
Next
.Close False
End With
End If
MyName = Dir
Loop
sh.[e16].Resize(m, 20) = brr
Application.ScreenUpdating = True
格式
MsgBox "汇总完毕!共耗时: " & Format(Timer - t, "0.000") & "秒!"
End Sub
|
|