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) = "新筆數"
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
發表於 2023-4-18 11:15
| 
