samwang

¦^´_ 1# gaishutsusuru
¥u·|VBA¡A¶È¨Ñ°Ñ¦Ò¡AÁÂÁÂ
Sub test()
Dim Arr, Brr, a, xD, T$, i&, i1&
Brr = Range([e4], [e65536].End(3).Offset(, 2))
Arr = Range([a4], [b65536].End(3))
For i1 = 1 To UBound(Brr)
    T = Brr(i1, 1)
    For i = 1 To UBound(Arr)
        a = Split(Arr(i, 2), " ")
        For j = 0 To UBound(a)
            If InStr(a(j), ",") Then a(j) = Replace(a(j), ",", "")
            If InStr(a(j), ".") Then a(j) = Replace(a(j), ".", "")
            If a(j) = T Then
                Brr(i1, 2) = Brr(i1, 2) + 1
                Brr(i1, 3) = IIf(Brr(i1, 3) = "", Arr(i, 1), Brr(i1, 3) & "," & Arr(i, 1))
            End If
        Next
    Next
Next
Range("e4").Resize(UBound(Brr), 3) = Brr
End Sub