Bonjour à toutes et à tous.
Sub analyse()
a = Feuil1.UsedRange
b = Feuil2.UsedRange
ReDim d(UBound(a))
n = 0
For i = 2 To UBound(a)
c = Split(a(i, 1), ",", , vbTextCompare)
For j = 0 To UBound(c)
For k = 2 To UBound(b)
If InStr(1, b(k, 4), c(j), vbTextCompare) > 0 Then d(n) = b(k, 5)
Next
Next
n = n + 1
Next
Feuil1.[B2].Resize(UBound(d)) = Application.Transpose(d)
End Sub
ou
Sub analyse()
a = Feuil1.UsedRange
B = Feuil2.UsedRange
ReDim d(UBound(a), 1)
n = 0
For i = 2 To UBound(a)
c = Split(a(i, 1), ",", , vbTextCompare)
For j = 0 To UBound(c)
For k = 2 To UBound(B)
If InStr(1, B(k, 4), c(j), vbTextCompare) > 0 Then
d(n, 0) = c(j): d(n, 1) = B(k, 5)
End If
Next
Next
n = n + 1
Next
With Feuil3
.[A2].Resize(UBound(d), 2) = d
.UsedRange.Cells.SpecialCells(xlCellTypeBlanks).Delete shift:=xlUp
End With
End Sub