Sub Doublons()
Dim P As Range, tablo, d1 As Object, i&, x$, d2 As Object, mes$
[A:D].Interior.ColorIndex = xlNone
Set P = Range("A1", [A65000].End(xlUp))
tablo = P.Resize(, 2) 'matrice plus rapide, au moins 2 éléments
Set d1 = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(tablo)
x = CStr(tablo(i, 1))
If x <> "" Then d1(x) = d1(x) + 1
Next
Set d2 = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(tablo)
x = CStr(tablo(i, 1))
If d1(x) > 1 Then
P(i).Resize(, 4).Interior.ColorIndex = 3
If Not d2.exists(x) Then
d2(x) = ""
mes = mes & vbLf & x
End If
End If
Next
MsgBox IIf(mes = "", "Aucune valeur en doublon", "Les valeurs suivantes sont en doublon :" & mes), 64, "Attention..."
End Sub