Dernière ligne si Doublons

=SI(NB.SI(Feuil2!B$2:B$20;Feuil1!A5)=0;"";INDEX(Feuil2!H$2:H$20;EQUIV(MAX(SI(Feuil2!B$2:B$20=Feuil1!A5;LIGNE(Feuil2!H$2:H$20)));LIGNE(Feuil2!H$2:H$20);0)))

Sub test()
For Each cell In Range("A:A").SpecialCells(xlCellTypeConstants): cell.Offset(, 2) = Correspondance(cell.Value): Next cell
End Sub

Function Correspondance(valeurCherche) As String
    For i% = Sheets("feuil2").Range("B65536").End(xlUp).Row To 2 Step -1
        If Sheets("feuil2").Range("B" & i) = valeurCherche Then Correspondance = Sheets("feuil2").Range("H" & i): Exit Function
    Next i
End Function

Sub test()
For Each cell In Range("A:A").SpecialCells(xlCellTypeConstants): PlacerInfo cell: Next cell
End Sub

Function PlacerInfo(ByVal cell As Range)
    Dim v1$, d1#, v2$, d2#: Set sh = Sheets("feuil2")
    Parametrage sh, cell.Value, Cells(4, 3), Cells(4, 5), v1, d1, v2, d2
    cell.Offset(, 2) = v1: cell.Offset(, 3) = IIf(d1 = 0, "", d1): cell.Offset(, 4) = v2: cell.Offset(, 5) = IIf(d2 = 0, "", d2)
End Function

Function Parametrage(sh, nom, m1, m2, ByRef v1$, ByRef d1#, ByRef v2$, ByRef d2#)
    For i% = sh.Range("B65536").End(xlUp).Row To 2 Step -1
        valeur = sh.Range("J" & i): laDate = sh.Range("I" & i)
        If sh.Range("B" & i) = nom Then
            If Right(sh.Range("H" & i), Len(m1)) = m1 And v1 = "" Then v1 = valeur: d1 = laDate
            If Right(sh.Range("H" & i), Len(m2)) = m2 And v2 = "" Then v2 = valeur: d2 = laDate
        End If
        If v1 <> "" And v2 <> "" Then Exit For
    Next i
End Function

Sub test()
Dim derlg As Long
Dim t
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
t = Time
derlg = Range("A65536").End(xlUp).Row
For Each cell In Range("A5:A" & derlg).SpecialCells(xlCellTypeConstants): PlacerInfo cell: Next cell
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
MsgBox Format(Time - t, "hh:mm:ss")
End Sub

Sub test()
Dim MOT1 As String, MOT2 As String, PremAdresse, c, PlageNoms, Zone, i&, _
Nb As Byte, pos As Byte
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Set PlageNoms = Sheets("Feuil1").Range("A5:F" & Sheets("Feuil1").Range("A" & Rows.Count).End(xlUp).Row)
Set Zone = Sheets("Feuil2").Range("B2:J" & Sheets("Feuil2").Range("J" & Rows.Count).End(xlUp).Row)
MOT1 = "MOT1"
MOT2 = "MOT2"
For i = 1 To PlageNoms.Rows.Count
Nb = Application.WorksheetFunction.CountIf(Zone.Columns(1), PlageNoms(i, 1))
If Nb > 0 Then
With Worksheets(2).Range("B2:B" & Zone.Rows.Count + 1)
    Set c = .Find(PlageNoms(i, 1), LookIn:=xlValues, lookat:=xlWhole, searchdirection:=xlPrevious)
    If Not c Is Nothing Then
        PremAdresse = c.Address
        Do
        pos = InStr(1, CStr(Sheets("Feuil2").Range("H" & c.Row).Value), MOT1)
            If pos > 0 Then PlageNoms(i, 4) = Sheets("Feuil2").Range("I" & c.Row).Value: PlageNoms(i, 3) = _
            Sheets("Feuil2").Range("J" & c.Row).Value: Exit Do
            Set c = .FindPrevious(c)
        Loop While Not c Is Nothing And c.Address <> PremAdresse
    End If
End With
End If
Next i
For i = 1 To PlageNoms.Rows.Count
Nb = Application.WorksheetFunction.CountIf(Zone.Columns(1), PlageNoms(i, 1))
If Nb > 0 Then
With Worksheets(2).Range("B2:B" & Zone.Rows.Count + 1)
    Set c = .Find(PlageNoms(i, 1), LookIn:=xlValues, lookat:=xlWhole, searchdirection:=xlPrevious)
    If Not c Is Nothing Then
        PremAdresse = c.Address
        Do
        pos = InStr(1, CStr(Sheets("Feuil2").Range("H" & c.Row).Value), MOT2)
            If pos > 0 Then PlageNoms(i, 6) = Sheets("Feuil2").Range("I" & c.Row).Value: PlageNoms(i, 5) = _
            Sheets("Feuil2").Range("J" & c.Row).Value: Exit Do
            Set c = .FindPrevious(c)
        Loop While Not c Is Nothing And c.Address <> PremAdresse
    End If
End With
End If
Next i
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub