Διαγράψτε διπλές εγγραφές χρησιμοποιώντας VBA στο Microsoft Excel

Anonim

Σε αυτό το άρθρο, θα δημιουργήσουμε μια μακροεντολή για την κατάργηση διπλών εγγραφών από τα δεδομένα.

Τα ακατέργαστα δεδομένα αποτελούνται από δεδομένα εργαζομένων, τα οποία περιλαμβάνουν όνομα, ηλικία και φύλο.

Λογική εξήγηση

Δημιουργήσαμε μια μακροεντολή "RemovingDuplicate" για την κατάργηση διπλών εγγραφών από τα δεδομένα. Αυτή η μακροεντολή προέρχεται αρχικά τα δεδομένα σε μια ακολουθία και στη συνέχεια κάνει σύγκριση μεταξύ των τιμών δύο συνεχόμενων σειρών για να μάθετε διπλές εγγραφές.

Επεξήγηση κώδικα

ActiveSheet.Sort.SortFields.Clear

Ο παραπάνω κώδικας χρησιμοποιείται για την κατάργηση τυχόν προηγούμενης ταξινόμησης στα δεδομένα.

ActiveSheet.Sort.SortFields.Add Key: = Range (Selection.Address), _

Ταξινόμηση: = xlSortOnValues, Σειρά: = xlΑύξουσα, DataOption: = xlSortTextAsNumbers

Ο παραπάνω κώδικας χρησιμοποιείται για την ταξινόμηση των δεδομένων στην πρώτη στήλη με αύξουσα σειρά.

Για i = ActiveSheet.Cells (Rows.Count, Selection.Column). End (xlUp). Row To Selection. Row + 1 Step -1

Ο παραπάνω κώδικας χρησιμοποιείται για την εφαρμογή αντίστροφου βρόχου, ξεκινώντας από την τελευταία σειρά στην επιλεγμένη σειρά.

ActiveSheet.Rows (i). Διαγραφή αλλαγής: = xlUp

Ο παραπάνω κώδικας χρησιμοποιείται για τη διαγραφή μιας γραμμής και τη μετακίνηση του δρομέα στην επάνω σειρά.

Ακολουθήστε παρακάτω για τον κωδικό

 Option Explicit Sub RemovingDuplicate () 'Declaring variables Dim i As Long' Απενεργοποίηση ενημερώσεων οθόνης Application.ScreenUpdating = False Range ("A11"). Επιλέξτε ActiveSheet.Sort.SortFields.Clear 'Ταξινόμηση δεδομένων με αύξουσα σειρά 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 (Rells) Selection.End (xlToRight). Colon). End (xlUp)). Count, Selection.Column). End (xlUp). Row To Selection. Row + 1 Step -1 'Σύγκριση τιμής δύο παρακείμενων κελιών για διπλές εγγραφές If ActiveSheet.Cells (i, Selection.Column) .Value = ActiveSheet.Cells ( (i - 1), Επιλογή. Στήλη). Αξία Στη συνέχεια 'Διαγράψτε την διπλή εγγραφή ActiveSheet. Σειρές (i). Διαγραφή αλλαγής: = xlUp Τέλος Αν Επόμενο i' Ενεργοποίηση οθόνης επάνω ημερομηνίες Application.ScreenUpdating = True End Sub 

Αν σας άρεσε αυτό το blog, μοιραστείτε το με τους φίλους σας στο Facebook. Επίσης, μπορείτε να μας ακολουθήσετε στο Twitter και το Facebook.

Θα θέλαμε πολύ να σας ακούσουμε, ενημερώστε μας πώς μπορούμε να βελτιώσουμε το έργο μας και να το κάνουμε καλύτερο για εσάς. Γράψτε μας στον ιστότοπο email