Andy2483

ÁÂÁ½׾Â,ÁÂÁ¦U¦ì«e½ú
«á¾ÇÂǦ¹©«½m²ß°}¦C»P¦r¨å,¾Ç²ß¤è®×¦p¤U,½Ð¦U¦ì«e½ú«ü±Ð

°õ¦æ«e:

¤U¸ü (79.44 KB)

2023-4-27 15:47

°õ¦æµ²ªG:

¤U¸ü (86.71 KB)

2023-4-27 15:48

Option Explicit
Sub TEST()
Dim Brr, Crr(1 To 100, 1 To 3), A, Y, i&, j%, T1$, T2$, T3$, TT$, N%
Dim xR As Range, Ra As Range, Sh As Worksheet, xBook As Workbook
Set Y = CreateObject("Scripting.Dictionary")
Brr = Range([C1], Cells(Rows.Count, 1).End(3))
For i = 2 To UBound(Brr)
   T1 = Brr(i, 1): T2 = Brr(i, 2): T3 = Brr(i, 3): TT = T2 & "/" & T3
   A = Y(TT): N = Y(TT & "|R"): N = N + 1
   If Not IsArray(A) Then A = Crr
   For j = 1 To 3: A(N, j) = Brr(i, j): Next
   Y(TT) = A: Y(TT & "|R") = N
Next
[K:M].ClearContents: [K1:M1] = [{"«¬¸¹","®y¼ÐX","®y¼ÐY"}]: N = 2
For Each A In Y.KEYS
   If InStr(A, "|") Then GoTo i01
   If Y(A & "|R") = 1 Then GoTo i01
   Cells(N, "K").Resize(Y(A & "|R"), 3) = Y(A)
   N = N + Y(A & "|R")
i01: Next
Set Y = Nothing: Erase Brr, Crr
End Sub