>>932
Sub Macro1()
　　rr = Cells(Rows.Count, 1).End(xlUp).Row
　　For i = 1 To rr
　　　　n = Cells(i, 1)
　　　　s = Cells(i, 2)
　　　　t = s & "・"
　　　　For j = 1 To i - 1
　　　　　　If Cells(j, 1) = n Then
　　　　　　　　w = Cells(j, 2)
　　　　　　　　If InStr(t, w) = 0 Then
　　　　　　　　　　t = t & w & "・"
　　　　　　　　End If
　　　　　　End If
　　　　Next
　　　　t = t & s & "・"
　　　　For j = i + 1 To rr
　　　　　　If Cells(j, 1) = n Then
　　　　　　　　w = Cells(j, 2)
　　　　　　　　If InStr(t, w) = 0 Then
　　　　　　　　　　t = t & w & "・"
　　　　　　　　End If
　　　　　　End If
　　　　Next
　　　　t = Left(t, Len(t) - 1)
　　　　t = Right(t, Len(t) - 1 - Len(s))
　　　　Cells(i, 3) = t
　　Next
End Sub