百合・D・ルフィバグ修正
Sub Macro2()
　　Dim d As Object
　　Set d = CreateObject("Scripting.Dictionary")
　　rr = Cells(Rows.Count, 1).End(xlUp).Row
　　For r = 1 To rr
　　　　For i = 1 To rr
　　　　　　If Cells(i, 1) = Cells(r, 1) Then
　　　　　　　　s = Cells(i, 2)
　　　　　　　　If Not d.exists(s) Then d.Add (s), 0
　　　　　　End If
　　　　Next
　　　　Cells(r, 3) = Join(d.keys, "・")
　　　　d.RemoveAll
　　Next
End Sub