­ã´£³¡ªL

Sub TEST()
Dim Arr, A, i&, xD, C%, V%, N%, T$(2), s%, ST$(2)
Set xD = CreateObject("Scripting.Dictionary")
For Each A In [A2:A13].Value
    If A <> "" Then xD(A & "") = 1: T(0) = T(0) & A & "_": C = C + 1
Next

Arr = Range([C2], [D65536].End(xlUp)(2))
For i = 1 To UBound(Arr) - 1
    If Arr(i, 1) <> "" Then T(1) = Arr(i, 1): T(2) = ""
    T(2) = T(2) & Arr(i, 2) & "_"
    V = V + xD(Arr(i, 2) & ""): N = N + 1
    If Arr(i + 1, 1) <> "" Or i = UBound(Arr) Then
       If V = C Then s = 2
       If T(2) = T(0) Then s = 1
       If N <> C Then s = 0
       ST(s) = ST(s) & "¡B" & T(1): V = 0: N = 0
    End If
101: Next i

[I2] = Mid(ST(1), 2)
[I3] = Mid(ST(2), 2)
End Sub