Andy2483

謝謝論壇,謝謝各位前輩
後學藉此帖練習陣列與字典,學習方案如下,請各位前輩指教

資料表:

下載 (28.61 KB)

2023-6-20 10:18

結果表執行前:

下載 (17.7 KB)

2023-6-20 10:18

執行結果:

下載 (24.27 KB)

2023-6-20 10:19

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