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.

ArrowMain

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.

ArrowOutput

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]