Function Conseils(r1 As Range, r2 As Range)
Dim t, d As Object, i&
t = r1.Resize(Application.CountA(r1.Columns(1))) 'matrice, plus rapide
Set d = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(t)
If Application.CountIf(r2, "*" & t(i, 1) & "*") Then d(t(i, 2)) = ""
Next
Conseils = d.keys 'vecteur horizontal
End Function