Option Explicit
Sub TEST_1()
Dim Brr, Crr, Z, i&, j%, R&, Y&, T$
Set Z = CreateObject("Scripting.Dictionary")
Brr = Range([工作表1!D1], [工作表1!A65536].End(3))
ReDim Crr(1 To UBound(Brr), 1 To 3)
For i = 1 To UBound(Brr)
T = Brr(i, 2) & "|" & Brr(i, 4)
R = Z(T)
If R = 0 Then
Y = Y + 1: R = Y
For j = 1 To 3: Crr(R, j) = Brr(i, j + 1): Next
Z(T) = R: GoTo i01
End If
Crr(R, 2) = Crr(R, 2) + Brr(i, 3)
i01: Next
With [Summary!A1].Resize(Y, 3)
.EntireColumn.ClearContents
.Value = Crr
End With
Set Z = Nothing: Erase Brr, Crr
End Sub
發表於 2021-5-25 10:39
| 
