Sub recherche_mapomme()
Dim t, dico1, c
t = Timer
Set dico1 = CreateObject("scripting.dictionary")
Set F1 = Feuil1: Set F2 = Feuil2
'remplacer g par h pour n'effacer que la colonne h
F2.Range("g2:h" & Rows.Count).ClearContents
tablo1 = F1.[c2].Resize(F1.[c1000000].End(xlUp).Row - 1, 5).Value
'dico1 : clef = concaténation de tablo1(i, 1) et de tablo1(i, 5)
' item = tablo1(i, 3)
For i = 1 To UBound(tablo1)
dico1("\" & tablo1(i, 1) & "\" & tablo1(i, 5) & "\") = tablo1(i, 3)
Next i
'pour chaque ligne de tablo2, on cherche sa correspondance dans dico1
'si elle existe, on la place dans la colonne 1 de tablo2
'si elle n'existe pas, on place "" dans la colonne 1 de tablo2
tablo2 = F2.[c2].Resize(F2.[c1000000].End(xlUp).Row - 1, 5).Value
For i = 1 To UBound(tablo2)
c = "\" & tablo2(i, 1) & "\" & tablo2(i, 4) & "\"
If dico1.exists(c) Then tablo2(i, 1) = dico1(c) Else tablo2(i, 1) = ""
Next i
'tablo2: on ne garde que la colonne 1
ReDim Preserve tablo2(1 To UBound(tablo2), 1 To 1)
' on écrit le résultat sur la feuille
' remplacer "g" par la colonne de destination
F2.Range("g2").Resize(UBound(tablo2)) = tablo2
F2.Range("g1") = "mapomme"
MsgBox Round(Timer - t, 1)
End Sub