Sub traitement()
Dim Dict, c As Range, pl() As Variant, result As String
Dim item As Variant, item2 As Variant, i As Long
Set Dict = CreateObject("Scripting.Dictionary")
For Each c In Selection
item = Split(c, "&")
For i = 0 To UBound(item)
item2 = Split(item(i), "/")
Dict(Trim(item2(0))) = Dict(Trim(item2(0))) & "," & Trim(item2(1))
Next i
item = Dict.keys
item2 = Dict.items
result = ""
For i = 0 To UBound(item)
result = result & " | " & item(i) & " : " & Mid(item2(i), 2)
Next i
c.Offset(, 1) = Mid(result, 4)
Next c
End Sub