Sub Complement()
Dim t, d As Object, i&, s, x$, j&, k&
t = Sheets("Element").[B1].CurrentRegion.Resize(, 2)
Set d = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(t): d(t(i, 1)) = t(i, 2): Next
With Sheets("Traitement").[B1].CurrentRegion.Resize(, 4)
t = .Value
For i = 2 To UBound(t)
s = Split(t(i, 1), vbLf)
If UBound(s) > 0 Then
x = s(0)
t(i, 4) = d(x)
For j = 1 To UBound(s)
If s(j) <> x Then
For k = 1 To UBound(s)
t(i, 4) = t(i, 4) & vbLf & d(s(k))
Next k
GoTo 1
End If
Next j
t(i, 1) = x
t(i, 3) = Evaluate(Replace(t(i, 3), vbLf, "+"))
End If
1 Next i
.Value = t 'restitution
End With
End Sub