|
改一下。。。
- Sub ykcbf() '//2024.12.31
- Application.ScreenUpdating = False
- Application.DisplayAlerts = False
- Set d = CreateObject("Scripting.Dictionary")
- Set sh = ThisWorkbook.Sheets("统计")
- On Error Resume Next
- For Each sht In Sheets
- If sht.Name <> sh.Name Then
- arr = sht.UsedRange
- For i = 3 To UBound(arr)
- s = arr(i, 1) & "|" & arr(1, 4)
- If Not d.exists(s) Then
- d(s) = Array(arr(i, 4) + arr(i, 5) + arr(i, 6), arr(i, 7), arr(i, 8))
- Else
- t = d(s)
- t(0) = t(0) + arr(i, 4) + arr(i, 5) + arr(i, 6)
- t(1) = t(1) + arr(i, 7)
- t(2) = t(2) + arr(i, 8)
- d(s) = t
- End If
- Next
- End If
- Next
- With sh
- arr = .UsedRange
- .UsedRange.Offset(2, 3).ClearContents
- For i = 3 To UBound(arr)
- For j = 4 To UBound(arr, 2) Step 3
- s = arr(i, 1) & "|" & arr(1, j)
- If d.exists(s) Then
- arr(i, j) = d(s)(0)
- arr(i, j + 1) = d(s)(1)
- arr(i, j + 2) = d(s)(2)
- End If
- Next
- Next
- .UsedRange = arr
- End With
- Set d = Nothing
- Application.ScreenUpdating = True
- MsgBox "OK!"
- End Sub
复制代码
|
|