Option Compare Text 'la casse est ignorée
Private Sub Worksheet_Activate()
Dim d As Object, tablo, i&, x$, P As Range, resu$()
'---liste sans doublon---
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
tablo = Sheets("Facture").UsedRange.Resize(, 25) 'matrice, plus rapide
For i = 2 To UBound(tablo)
x = Application.Trim(tablo(i, 25))
If x = "RdV Fait" Then d(x & tablo(i, 1) & tablo(i, 5)) = ""
Next i
'---tableau des résultats---
Set P = Range("A1", UsedRange).Resize(, 11)
If P.Rows.Count < 6 Then Exit Sub
Set P = P.Offset(5).Resize(P.Rows.Count - 5)
tablo = P 'matrice, plus rapide
ReDim resu(1 To UBound(tablo), 1 To 1)
For i = 1 To UBound(tablo)
x = Application.Trim(Replace(tablo(i, 10), "Facturé", ""))
resu(i, 1) = x & IIf(d.exists(x & tablo(i, 11) & tablo(i, 2)), " Facturé", "")
Next i
'---restitution---
Application.EnableEvents = False 'désactive les évènements
P(1, 10).Resize(i - 1) = resu
Application.EnableEvents = True 'réactive les évènements
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Worksheet_Activate 'lance la macro
End Sub