Top Assistante - Macros supprimer les doublons

Macros / VBA > Excel

26-Mar-2005

Choix d'une méthode

Sans macro
Supprimer les doublons en colonne à l'aide d'une fonction
Supprimer les doublons sur plusieurs colonnes

Avec macro
Supprimer les doublons en colonne
Supprimer les doublons en ligne

Supprimer les doublons en ligne

La problématique est la suivante. Fab dispose d'un planning relatif à des gardes journalières. Pour chaque plage horaire, la garde est assurée par deux équipes de 4 personnes chacune (soit 8 personnes). Chaque nom est saisi grâce à une liste déroulante (option Validation des données). L'objectif est de s'assurer que, sur une même ligne, un nom ne figure pas deux fois.

Extrait du tableau de garde : les doublons devront apparaître en rouge.
Tel est le cas de Nom3 qui apparaît deux fois pour la tranche de 5h30 du 10 août !

La macro que je vous propose ci-dessous est facilement adpatable à d'autres cas de figure.
Ouvrez le fichier à contrôler puis l'éditeur VBA (Alt F11).
Repérez le nom du fichier auquel vous souhaitez affecter la macro et double-cliquez sur ThisWorkbook.

Nous utiliserons une procédure spéciale, Workbook_SheetChange, qui se lance automatiquement à chaque modification opérée dans une cellule.

Copiez le code ci-après :

Macro	Commentaires
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim MaLigne As Integer	Définit MaLigne
Dim AVerifier As Variant	Définit AVerifier
MaLigne = ActiveCell.Row	Récupère le numéro de la ligne en cours d'examen
debut = ActiveCell.Address	récupère l'adresse de la cellule en cours dans debut (cellule que l'on vient de modifier)
AVerifier = ActiveCell	récupère le contenu de la cellule en cours dans AVerifier (cellule que l'on vient de modifier)
Range("B" & MaLigne).Select	sélectionne la 1ère cellule à examiner (adresse formée avec la mention de la colonne B et le numéro de la ligne récupéré plus haut)
While ActiveCell.Column < 11	va répéter les instructions sur fond rose jusqu'à la 11e colonne (colonne K)
If ActiveCell.Address <> debut Then	vérifie qu'on n'est pas en train d'examiner la cellule que l'on vient tout juste de modifier
CelluleEnCours = ActiveCell.Address	affecte à CelluleEnCours l'adresse de la cellule que l'on examine
If ActiveCell = AVerifier Then	si la cellule modifiée et celle en cours d'examen sont identiques
trouvé = True	on met le marqueur trouvé sur vrai
ActiveCell.Font.ColorIndex = 3	on affecte une typo rouge au texte de la cellule en cours d'examen
Range(debut).Select	on se repositionne sur la cellule de départ
ActiveCell.Font.ColorIndex = 3	et on fait de même (typo rouge)
Range(CelluleEnCours).Select	on se repositionne sur la cellule qu'on était en train d'examiner
Else	si les deux cellules ont des contenus différents
ActiveCell.Font.ColorIndex = 1	on affecte à la cellule en cours une typo noire
If trouvé <> True Then	si à aucun moment de doublon n'a été trouvé, alors
Range(debut).Select	on repositionne le curseur sur la cellule d'origine (celle qui a été modifiée)
ActiveCell.Font.ColorIndex = 1	on s'assure que la typo est bien noire
End If	fin du contrôle pour la cellule en cours
Range(CelluleEnCours).Select	on se repositionne sur la cellule en cours d'examen
End If	fin de la 2e condition
End If	Fin de la 1ere condition
ActiveCell.Offset(0, 1).Select	on se déplace d'une colonne vers la droite pour en examiner le contenu
Wend	tant que la cellule K n'est pas atteinte, on répète les inscructions sur fond rose
Range(debut).Select	une fois le programme terminé, on repositionne le curseur sur la cellule qui avait été modifiée
End Sub

Les paramètres à adapter à votre feuille figurent en rouge.

B : lettre qui correspond à la première colonne à comparer. L'illustration montre clairement que les premiers noms commencent en colonne B. Par mesure de sécurité, on aurait tout aussi bien pu mettre A mais autant gagner quelques fractions de secondes !
11 : n° de la colonne contenant le dernier nom à comparer. La 11e colonne correspond à K.

Haut

Niveau