Une macro pour supprimer / localiser les doublons dans un classeur Excel

On ne le répétera pas assez, Excel est un formidable outil. Je vous propose dans ce tuto de réaliser une petite macro pour supprimer les doublons dans un classeur Excel. Une petite variante de cette macro pour Excel permettra au contraire de ne conserver QUE les doublons.

Comment créer vos macros ?

Pour réaliser ce tutoriel vous devez savoir comment créer et exécuter une une macro dans Excel :

• Ouvrez un classeur Excel dans lequel vous souhaitez exécuter des macros
• Affichez le menu Développeur dans le ruban Excel s’il n’est pas présent.
• Depuis le menu Développeur cliquez sur Macro
• Nommez votre Macro comme vous le souhaitez
• Copiez du code entre les balises Sub et End Sub
• Pressez la touche F5 pour exécuter votre code d’une traite ou F8 pour l’exécuter pas à pas.

Exemple d’une macro dans Excel

Des macros pour supprimer ou identifier des doublons

Code 1 – Supprimer des lignes en double

Dans ce premier exemple 2 lignes seront considérées comme étant des doublons si les valeurs leurs colonnes A et B sont identiques.

Ces 2 valeurs sont représentées dans le script par les variables word1 et word2.

Sub RemoveDuplicate()

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

Après avoir exécuter votre macro la ligne en double a bien disparût

Code 2 – Conserver uniquement les doublons

Dans ce deuxième exemple seule la valeur de la colonne 1 de chaque ligne sera utilisée comme condition. Par contre ce script va conserver uniquement les doublons et purger tout le reste.

Sub KeepDuplicate()

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 !