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
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
Set Plage = Range("A" & NoLig & ":" & Cells(Cell.Row, DerCol).Address)
par
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
1 2 3
| If Err <> 0 Then
Rows(Cell.Row).EntireRow.Delete
End If |
par
1 2 3
| If Err <> 0 Then
Rows(Cell.Row).EntireRow.Hidden = True
End If |
Partager