各位大神，求助！！！！

Option Explicit
Sub abc()
　Dim a, i, j, t, m, d, key
　Set d = CreateObject("scripting.dictionary")
　a = [a1].CurrentRegion.Resize(, 2).Value
　For i = 2 To UBound(a)
　　t = Split(a(i, 2), "，")
　　For j = 0 To UBound(t)
　　　d(t(j)) = d(t(j)) & Space(1) & a(i, 1)
　　Next
　Next
　ReDim a(1 To d.Count, 20) As String
　For Each key In d.keys
　　t = Split(d(key)): m = m + 1
　　a(m, 0) = key
　　For j = 1 To UBound(t)
　　　a(m, j) = t(j)
　　Next
　Next
　[d2].Resize(UBound(a), UBound(a, 2) + 1) = a
End Sub

G5单元格输入公式：=INDEX($A:$A,SMALL(IF(ISERROR(SEARCH($F5,$B$5:$B$14))=FALSE,ROW($B$5:$B$14),4^10),COLUMN(A1)))&""
三健结束