Andy2483

ÁÂÁ½׾Â,ÁÂÁ¦U¦ì«e½ú
«á¾ÇÂǦ¹©«½m²ß°}¦C»P¦r¨å,¦b¦P¤@°}¦C¸Ì±N·s­ÈÂл\­È,¤§«á¼g¤J¥Ø¼Ð®æ,
¾Ç²ß¤è®×¦p¤U,½Ð¦U¦ì«e½ú«ü±Ð

°õ¦æ«e:

¤U¸ü (31.24 KB)

2023-4-18 11:15

°õ¦æµ²ªG:

¤U¸ü (43.57 KB)

2023-4-18 11:15

Option Explicit
Sub TEST_2()
Dim Brr, Y, Z, i&, j&, T$, xR As Range
Set Y = CreateObject("Scripting.Dictionary")
Set xR = Range([B1], Cells(Rows.Count, 1).End(3)): Brr = xR
For i = 2 To UBound(Brr)
   If i = 2 Then Brr(1, 1) = "±Æ°£­«½Æ": Brr(1, 2) = "·sµ§¼Æ"
   Z = Split(Brr(i, 1), ",")
   For j = 0 To UBound(Z)
      If Y(i & "|" & Z(j)) = "" Then
         T = Y(i)
         If T = "" Then T = Z(j) Else: T = T & "," & Z(j)
         Brr(i, 1) = T: Y(i) = T: Y(i & "|" & Z(j)) = 1
         Y(i & "|c") = Y(i & "|c") + 1: Brr(i, 2) = Y(i & "|c")
      End If
   Next
Next
With xR.Offset(0, 2)
   .EntireColumn.ClearContents
   .Value = Brr
End With
Set Y = Nothing: Set xR = Nothing: Erase Brr, Z
End Sub