Trong bài viết này, chúng tôi sẽ tạo macro để loại bỏ các bản ghi trùng lặp khỏi dữ liệu.

Dữ liệu thô bao gồm dữ liệu nhân viên, bao gồm Tên, Tuổi và Giới tính.

ArrowMain

Giải thích logic

Chúng tôi đã tạo macro “RemovingDuplicate” để xóa các bản ghi trùng lặp khỏi dữ liệu. Macro này trước hết lấy nguồn dữ liệu theo một trình tự và sau đó so sánh giữa các giá trị của hai hàng liên tiếp để tìm ra các bản ghi trùng lặp.

ArrowOutput

Giải thích mã

ActiveSheet.Sort.SortFields.Clear Đoạn mã trên được sử dụng để loại bỏ mọi cách sắp xếp trước đó trên dữ liệu.

ActiveSheet.Sort.SortFields.Add Key: = Range (Selection.Address), _ SortOn: = xlSortOnValues, Order: = xlAscending, DataOption: = xlSortTextAsNumbers Đoạn mã trên được sử dụng để sắp xếp dữ liệu trong cột đầu tiên theo thứ tự tăng dần.

Đối với i = ActiveSheet.Cells (Rows.Count, Selection.Column) .End (xlUp) .Row To Selection.Row + 1 Bước -1 Đoạn mã trên được sử dụng để áp dụng lặp ngược, bắt đầu từ hàng cuối cùng đến hàng đã chọn.

ActiveSheet.Rows (i) .Delete shift: = xlUp Đoạn mã trên được sử dụng để xóa một hàng và di chuyển con trỏ đến hàng trên.

Vui lòng theo dõi bên dưới để biết mã

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

Nếu bạn thích blog này, hãy chia sẻ nó với bạn bè của bạn trên Facebook và Facebook.

Chúng tôi rất muốn nghe ý kiến ​​từ bạn, hãy cho chúng tôi biết cách chúng tôi có thể cải thiện công việc của mình và làm cho nó tốt hơn cho bạn. Viết thư cho chúng tôi [email protected]