|
- Sub test()
- Dim r%, i%
- Dim arr, brr
- Dim wb As Workbook
- Dim ws As Worksheet
- Dim mypath$, myname$
- Dim d As Object
- Set d = CreateObject("scripting.dictionary")
- Application.ScreenUpdating = False
- Application.DisplayAlerts = False
- mypath = ThisWorkbook.Path & ""
- myname = Dir(mypath & "*.xls")
- m = 0
- Do While myname <> ""
- If myname <> ThisWorkbook.Name Then
- Set wb = GetObject(mypath & myname)
- With wb
- With .Worksheets("×ãÀºÅÅ")
- r = .Cells(.Rows.Count, 1).End(xlUp).Row
- arr = .Range("a4:l" & r)
- For i = 1 To UBound(arr)
- xm = arr(i, 3) & "+" & arr(i, 8)
- If Not d.exists(xm) Then
- m = m + 1
- ReDim brr(1 To 4)
- brr(1) = m
- brr(2) = arr(i, 3)
- brr(3) = arr(i, 8)
- Else
- brr = d(xm)
- End If
- brr(4) = brr(4) + arr(i, 12)
- d(xm) = brr
- Next
- End With
- .Close False
- End With
- End If
- myname = Dir
- Loop
- With Worksheets("sheet3")
- .Range("i4").Resize(d.Count, UBound(brr)) = Application.Transpose(Application.Transpose(d.items))
- End With
- End Sub
¸´ÖÆ´úÂë |
|