Sub Doublons()
Dim ncol%, R As Range, t, tablo, ub%, resu(), d As Object, i&, n%, j%, x
ncol = 5 'nombre maximum de colonnes des résultats, à adapter
Set R = [B1:F180000] 'à adapter
'---initialisation---
R = "=RANDBETWEEN(1," & ncol & ")" 'ALEA.ENTRE.BORNES
R = R.Value 'supprime les formules
'---traitement des doublons---
t = Timer
tablo = R 'matrice, plus rapide
ub = UBound(tablo, 2)
ReDim resu(1 To UBound(tablo), 1 To ncol)
Set d = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(tablo)
d.RemoveAll 'RAZ
n = 0
For j = 1 To ub
x = tablo(i, j)
If Not d.exists(x) Then d(x) = "": n = n + 1: resu(i, n) = x
Next j, i
'---restitution---
With [I1] '1ère cellule de restitution, à adapter
.Resize(i - 1, ncol) = resu
.Offset(i - 1).Resize(Rows.Count - i - .Row + 2, ncol).ClearContents 'RAZ en dessous
End With
MsgBox Format(i - 1, "#,##0") & " lignes traitées en " & Format(Timer - t, "0.0 \sec"), , "Doublons"
End Sub