Option Explicit
Sub TEST()
Dim Brr, Z, i&, j%, C%, T$
'¡ô«Å§iÅܼÆ
Set Z = CreateObject("Scripting.Dictionary")
'¡ô¥OZÅܼƬO ¦r¨å
Brr = Range([J2], [A65536].End(3))
'¡ô¥OBrrÅܼƬO ¤Gºû°}¦C,¥HA~JÄæÀx¦s®æȱa¤J°}¦C¤¤
For i = 3 To UBound(Brr)
For j = 3 To 9 Step 3
For C = j - 1 To j + 1
T = Brr(i, 1) & Brr(1, j): Z(T) = Z(T) + Brr(i, C)
Next
Next
Next
'¡ô³]¶¶°j°é±N²Õ¦X¦r¦ê·íkey,item¬O ®É¼Æ²Ö¥[È
Brr = Range([P2], [L65536].End(3))
'¡ô¥OBrr°}¦CÈ´«²±¸Ë¥Ø¼ÐÀx¦s®æÈ
For i = 2 To UBound(Brr)
For j = 2 To 5
Brr(i, j) = Z(Brr(1, j) & Brr(i, 1))
Next
Next
'¡ô³]¶¶°j°é±NZ¦r¨å¤¤ªºitemȦR¥X¨Óµ¹°}¦C
Range([P2], [L65536].End(3)) = Brr
'¡ô¥OBrr°}¦Cȼg¤JÀx¦s®æ¤¤
Set Z = Nothing: Erase Brr
End Sub