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) & "、" & T(1): V = 0: N = 0
End If
101: Next i