|
- Sub Macro1()
- Dim mypath$$, wj$$, wb As Workbook
- Dim i&, j%, zf$$, arr, brr, d
- Application.ScreenUpdating = False
- Set d = CreateObject("scripting.dictionary")
- mypath = ThisWorkbook.Path & ""
- arr = Range("b1").CurrentRegion
- wj = Dir(mypath & "*.xls*")
- Do While wj <> ""
- If wj <> ThisWorkbook.Name Then
- With GetObject(mypath & wj)
- brr = .Sheets(1).Range("b1").CurrentRegion
- .Close 0
- End With
- For i = 5 To UBound(brr)
- For j = 1 To UBound(brr, 2) Step 2
- zf = brr(i, j) & "," & i & "," & j
- d(zf) = d(zf) + brr(i, j + 1)
- Next
- Next
- End If
- wj = Dir
- Loop
- For i = 5 To UBound(arr)
- For j = 1 To UBound(arr, 2) Step 2
- zf = arr(i, j) & "," & i & "," & j
- arr(i, j + 1) = d(zf)
- Next
- Next
- Range("b1").CurrentRegion = arr
- Application.ScreenUpdating = True
- End Sub
复制代码 |
|