­ã´£³¡ªL

Sub TEST()
Dim Arr, xD, i&, T1$, T2$, U&, N&
Set xD = CreateObject("Scripting.Dictionary")
Arr = Range([B1], Cells(Rows.Count, 1).End(xlUp))
For i = 2 To UBound(Arr)
    T1 = Arr(i, 1):  T2 = Arr(i, 2):  Arr(i, 2) = ""
    If T1 = "" Then GoTo 101
    If xD(T1 & "/") <> "" Then GoTo 101 '¤w¬O³Ì°ªµ¥¯Å
    U = xD(T1)
    If U = 0 Then
       N = N + 1:  U = N:  xD(T1) = N:  Arr(N + 1, 1) = T1
    End If
    If T2 <> "" Then Arr(U + 1, 2) = T2
    If Right(T2, 2) = "1." Then xD(T1 & "/") = "AAA" '°O¿ý¬°³Ì°ªµ¥¯Å
101: Next i
If N > 0 Then [D1:E1].Resize(N + 1) = Arr
End Sub


'==========================================