В этой статье мы создадим макрос для удаления повторяющихся записей из данных.

Необработанные данные состоят из данных сотрудников, включая имя, возраст и пол.

ArrowMain

Логическое объяснение

Мы создали макрос «RemovingDuplicate» для удаления повторяющихся записей из данных. Этот макрос сначала создает данные в последовательности, а затем сравнивает значения двух последовательных строк, чтобы найти повторяющиеся записи.

ArrowOutput

Объяснение кода

ActiveSheet.Sort.SortFields.Clear Приведенный выше код используется для удаления любой предыдущей сортировки данных.

ActiveSheet.Sort.SortFields.Add Key: = Range (Selection.Address), _ SortOn: = xlSortOnValues, Order: = xlAscending, DataOption: = xlSortTextAsNumbers Приведенный выше код используется для сортировки данных в первом столбце в порядке возрастания.

Для i = ActiveSheet.Cells (Rows.Count, Selection.Column) .End (xlUp) .Row To Selection.Row + 1 Step -1 Приведенный выше код используется для применения обратного цикла, начиная с последней строки до выбранной строки.

ActiveSheet.Rows (i) .Delete shift: = xlUp Приведенный выше код используется для удаления строки и перемещения курсора в верхнюю строку.

Пожалуйста, введите код ниже

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

Если вам понравился этот блог, поделитесь им с друзьями на Facebook и Facebook.

Мы будем рады услышать от вас, дайте нам знать, как мы можем улучшить нашу работу и сделать ее лучше для вас. Напишите нам на [email protected]