SysKB.com

Je vous propose une petite macro pour supprimer les doublons dans un classeur Excel. Une petite variante de cette macro permettra au contraire de ne conserver QUE les doublons.

Dans cette exemple des lignes seront considérées comme des doublons si les valeurs des colonnes 1 ET 2 sont identiques. Ces 2 valeurs sont représentées dans le script par les variables word1 et word2.  A la fin du script les lignes dupliquées sont tout simplement supprimées.

Sub RemoveDuplicate()

Sheets(1).UsedRange.EntireRow.Sort Key1:=Range("A1"), Key2:=Range("B1")

i = 1: j = 1
Sheets(1).Select
While Cells(i, 1).Value <> ""
 word1 = Cells(i, 1).Value
 word2 = Cells(i, 2).Value

 j = i + 1
 If Cells(i, 2).Value <> "ERASE" Then
 While Cells(j, 1).Value <> ""
 If Cells(j, 1).Value = word1 And Cells(j, 2).Value = word2 Then
 Cells(j, 3).Value = "ERASE"
 End If
 j = j + 1
 Wend
 End If
i = i + 1
Wend

For j = i To 1 Step -1
 If Cells(j, 3).Value = "ERASE" Then
 Rows(j).Select
 Selection.Delete Shift:=xlUp
 End If
Next j

End Sub

Dans ce deuxième exemple seule la valeur de la colonne 1 de chaque ligne sera utilisée comme condition. Par contre à la fin du script, contrairement à l’exemple précédent, seules les doublons seront conservés !

Sub RemoveDuplicate()

Sheets(1).UsedRange.EntireRow.Sort Key1:=Range("A1"), Key2:=Range("B1")

i = 1: j = 1
Sheets(1).Select
While Cells(i, 1).Value <> ""
 word1 = Cells(i, 1).Value

 j = i + 1
 If Cells(i, 2).Value <> "ERASE" Then
 While Cells(j, 1).Value <> ""
 If Cells(j, 1).Value = word1 Then
 Cells(j, 2).Value = "ERASE"
 End If
 j = j + 1
 Wend
 End If
i = i + 1
Wend

For j = i To 1 Step -1
 If Cells(j, 2).Value <> "ERASE" Then
 Rows(j).Select
 Selection.Delete Shift:=xlUp
 End If
Next j

End Sub

Maintenant à vous de composer selon votre besoin, j’espère dans tous les cas que ces petites macros vous feront gagner beaucoup de temps !