Sub AppelSub()
Set Table = [BD] ' champ table source
Set Clés = Range("C2:C201") ' champ des clés recherchées
Set Résultat = Range("G2:J201") ' champ résultat
colResult = 2
ncolResult = 4
RechvMultCol Clés, Table, Résultat, ncolResult
End Sub
Sub RechvMultCol(Clés, Table, Résultat, ncolResult)
Application.ScreenUpdating = False
Set d = CreateObject("Scripting.Dictionary")
a = Table.Value ' table source
b = Clés.Value ' table des clés recherchées
For i = LBound(a) To UBound(a)
t = CStr(a(i, 1))
d(t) = a(i, 2)
For k = 3 To ncolResult + 1
d(t) = d(t) & " : " & a(i, k)
Next k
Next i
Dim temp()
ReDim temp(LBound(b) To UBound(b), 1 To UBound(a, 2))
For i = LBound(b) To UBound(b)
t = CStr(b(i, 1))
tmp = d(t)
tbl = Split(tmp, ":")
For k = LBound(tbl) To UBound(tbl)
temp(i, k + 1) = tbl(k)
Next k
Next i
Résultat.Value = temp
End Sub