Sub btnDoublons_Click()
Dim L As Long
Dim TabTemp As Variant
Dim TabTemp2() As Variant
Dim Db As New Collection
Dim Nc As Byte
Dim C As Byte
With ActiveSheet
L = .Range("A65536").End(xlUp).Row
C = .Range("A1").SpecialCells(xlLastCell).Column
Nc = Val(InputBox("Sur combien de colonnes ?", "Elimination des Doublons", "10"))
If Nc < 1 Or Nc > C Then Exit Sub
[COLOR="Red"]Application.ScreenUpdating = False
ActiveWindow.WindowState = xlMinimized[/COLOR]
'Mémoriser les données dans un tableau variant temporaire
TabTemp = .Range(.Cells(1, 1), .Cells(L, C)).Value
ReDim TabTemp2(UBound(TabTemp, 1), 2)
'Concaténer les colonnes de données dans un tableau variant temporaire
For L = 1 To UBound(TabTemp, 1)
For C = 1 To Nc
TabTemp2(L, 1) = TabTemp2(L, 1) & CStr(TabTemp(L, C))
Next C
Next L
'Détecter les doublons (méthode de J.Walkenbach)
On Error GoTo Doublons:
For L = 1 To UBound(TabTemp2, 1)
Db.Add TabTemp2(L, 1), CStr(TabTemp2(L, 1))
Next L
On Error GoTo 0
'Supprimer les lignes de doublons dans la feuille
For L = UBound(TabTemp2, 1) To 1 Step -1
If TabTemp2(L, 2) > 0 Then
.Rows(L).EntireRow.Delete
End If
Next L
End With
[COLOR="red"] ActiveWindow.WindowState = xlMaximized
Application.ScreenUpdating = True[/COLOR]
Exit Sub
Doublons:
TabTemp2(L, 2) = 1
Resume Next
End Sub