Supprimer les doublons avec ou sans tri préalable

[ouskel'n'or]

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 :

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 :

        Set Plage = Range("A" & NoLig & ":" & Cells(Cell.Row, DerCol).Address)

par

Code :

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 :

1
2
3
            If Err <> 0 Then
                Rows(Cell.Row).EntireRow.Delete
            End If

par

Code :

1
2
3
            If Err <> 0 Then
                Rows(Cell.Row).EntireRow.Hidden = True
            End If