Sub EffaceDoublons()
Dim t, r As Range, tablo, n%, d As Object, i&, j%, x$, doublon&
t = Timer
Set r = Range("K2:BH" & Cells(Rows.Count, "H").End(xlUp).Row)
r.Replace " ", "", xlPart 'supprime les espaces
tablo = r
n = UBound(tablo, 2)
Set d = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(tablo)
d.RemoveAll
For j = 1 To n
If tablo(i, j) <> "" Then
x = LCase(tablo(i, j))
If d.Exists(x) Then
tablo(i, j) = ""
doublon = doublon + 1
Else
d.Add x, x
End If
End If
Next
Next
r = tablo
MsgBox "Doublons supprimés " & doublon & vbLf & _
"Durée " & Format(Timer - t, "0.00 \s")
End Sub