Supprimer les doublons en utilisant VBA dans Microsoft Excel
Dans cet article, nous allons créer une macro pour supprimer les enregistrements en double des données.
Les données brutes se composent des données des employés, qui incluent le nom, l’âge et le sexe.
Explication logique
Nous avons créé une macro «RemovingDuplicate» pour supprimer les enregistrements en double des données. Cette macro recherche d’abord les données dans une séquence, puis effectue une comparaison entre les valeurs de deux lignes consécutives pour trouver les enregistrements en double.
Explication du code
ActiveSheet.Sort.SortFields.Clear Le code ci-dessus est utilisé pour supprimer tout tri précédent sur les données.
ActiveSheet.Sort.SortFields.Add Key: = Range (Selection.Address), _ SortOn: = xlSortOnValues, Order: = xlAscending, DataOption: = xlSortTextAsNumbers Le code ci-dessus est utilisé pour trier les données de la première colonne par ordre croissant.
Pour i = ActiveSheet.Cells (Rows.Count, Selection.Column) .End (xlUp) .Row To Selection.Row + 1 Step -1 Le code ci-dessus est utilisé pour appliquer une boucle inversée, en commençant par la dernière ligne jusqu’à la ligne sélectionnée.
ActiveSheet.Rows (i) .Delete shift: = xlUp Le code ci-dessus est utilisé pour supprimer une ligne et déplacer le curseur sur la ligne supérieure.
Veuillez suivre ci-dessous pour le code
Option Explicit Sub RemovingDuplicate() 'Declaring variables Dim i As Long 'Disabling screen updates Application.ScreenUpdating = False Range("A11").Select ActiveSheet.Sort.SortFields.Clear 'Sorting data in ascending order ActiveSheet.Sort.SortFields.Add Key:=Range(Selection.Address), _ SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortTextAsNumbers With ActiveSheet.Sort .SetRange Range(Selection.Offset(1, 0), ActiveSheet.Cells(Rows.Count, Selection.End(xlToRight).Column).End(xlUp)) .Header = xlNo .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With 'Looping through all the cells For i = ActiveSheet.Cells(Rows.Count, Selection.Column).End(xlUp).Row To Selection.Row + 1 Step -1 'Comparing value of two adjacent cells for duplicate records If ActiveSheet.Cells(i, Selection.Column).Value = ActiveSheet.Cells((i - 1), Selection.Column).Value Then 'Delete the duplicate record ActiveSheet.Rows(i).Delete shift:=xlUp End If Next i 'Enabling screen updates Application.ScreenUpdating = True End Sub
Si vous avez aimé ce blog, partagez-le avec vos amis sur Facebook et Facebook.
Nous serions ravis de vous entendre, faites-nous savoir comment nous pouvons améliorer notre travail et le rendre meilleur pour vous. Écrivez-nous à [email protected]