|
Sub 汇总()
Application.ScreenUpdating = False
Set d = CreateObject("scripting.dictionary")
Set sh = ThisWorkbook.Worksheets(1)
rs = sh.Cells(Rows.Count, 1).End(xlUp).Row
sh.Range("d8:af" & rs) = Empty
ar = sh.Range("a8:af" & rs)
For i = 1 To UBound(ar)
If Trim(ar(i, 3)) <> "" Then
d(Trim(ar(i, 3))) = i
End If
Next i
f = Dir(ThisWorkbook.Path & "\*.xls*")
Do While f <> ""
If f <> ThisWorkbook.Name Then
Set wb = Workbooks.Open(ThisWorkbook.Path & "\" & f, 0)
ws = wb.Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row
br = wb.Worksheets(1).Range("a8:af" & rs)
For i = 1 To UBound(br)
If Trim(br(i, 4)) > 0 Then
m = d(Trim(br(i, 3)))
If m <> "" Then
For j = 4 To UBound(br, 2)
ar(m, j) = br(i, j)
Next j
End If
End If
Next i
wb.Close False
End If
f = Dir
Loop
sh.Range("a8:af" & rs) = ar
Application.ScreenUpdating = True
End Sub
|
|