But :
- Supprimer les doublons sans avoir à trier prélablement les données
- Supprimer les doublons "vrais" : toutes les cellules de la ligne identiques
- Supprimer les doublons "partiels" : plage de cellules de la ligne limitée à des colonnes sélectionnées
- Possibilité de masquer les doublons plutôt que les supprimer
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
Option Explicit
 
Sub SupKillDelLesDoublons()
Dim Collect As New Collection
Dim col As Range, Plage As Range, Cell As Range
Dim NoLig As Long, DerCol As Integer
Dim Derlig As Long, Donnee As String
 
    Derlig = Cells(Columns(1).Cells.Count, 1).End(xlUp).Row
    DerCol = Cells(1, Rows(1).Cells.Count).End(xlToLeft).Column
    For NoLig = Derlig To 1 Step -1
        Set Cell = Range("A" & NoLig)
        Set Plage = Range("A" & NoLig & ":" & Cells(Cell.Row, DerCol).Address)
        For Each col In Plage
            Donnee = Donnee & Cells(Cell.Row, col.Column) & ";"
        Next
        On Error Resume Next
            Collect.Add CStr(NoLig), Donnee
            If Err <> 0 Then
                Rows(Cell.Row).EntireRow.Delete
            End If
            Donnee = ""
        Err.Clear
    Next
End Sub
Pour vérifier les doublons selon les données contenues dans des cellules discontinues, (dans l'exemple ci-après, les colonnes A, C, D, F et J) remplacer la ligne
Code : Sélectionner tout - Visualiser dans une fenêtre à part
        Set Plage = Range("A" & NoLig & ":" & Cells(Cell.Row, DerCol).Address)
par
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
Dim Ligne$
 
        Ligne = Cell.Address & "," & Cell.Offset(0, 2).Address & "," & _
        Cell.Offset(0, 3).Address & "," & Cell.Offset(0, 5).Address & _
        "," & Cell.Offset(0, 9).Address
        Set Plage = Range(Ligne)
Pour masquer les doublons, remplacer
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
            If Err <> 0 Then
                Rows(Cell.Row).EntireRow.Delete
            End If
par
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
            If Err <> 0 Then
                Rows(Cell.Row).EntireRow.Hidden = True
            End If