Sub Recherche_Perf()
Dim tablo, xrg As Range
Dim i As Long, i0 As Long, i1 As Long
Dim dico As Dictionary, Date_Perf(1 To 2)
Application.ScreenUpdating = False
Set dico = CreateObject("Scripting.Dictionary")
i = Cells(Rows.Count, "a").End(xlUp).Row
Set xrg = Range(Range("a2"), Range("I" & i))
tablo = xrg.Value: i0 = LBound(tablo): i1 = UBound(tablo)
For i = i0 To i1
If tablo(i, 1) <> "" Then
If Not dico.exists(tablo(i, 1)) Then
Date_Perf(1) = tablo(i, 4)
Date_Perf(2) = tablo(i, 9)
dico(tablo(i, 1)) = Date_Perf
Else
If Abs(tablo(i, 4) - Date) < Abs(dico(tablo(i, 1))(1) - Date) Then
Date_Perf(1) = tablo(i, 4)
Date_Perf(2) = tablo(i, 9)
dico(tablo(i, 1)) = Date_Perf
End If
End If
End If
Next i
ReDim res(i0 To i1)
For i = i0 To i1
If tablo(i, 1) <> "" Then res(i) = dico(tablo(i, 1))(2)
Next i
Range("j2").Resize(i1 - i0 + 1) = Application.Transpose(res)
MsgBox "Recherche Performance : Terminée !"
Application.ScreenUpdating = True
End Sub