Untitled
unknown
plain_text
2 years ago
1.4 kB
7
Indexable
Sub HighlightDuplicateRowsWithoutCreateObject()
Dim ws As Worksheet
Dim lastRow As Long
Dim colToCheck As String
Dim rng As Range
Dim cell As Range
Dim dict As Object 'Scripting.Dictionary
Dim key As Variant
' ??nh ngh?a tên c?t c?n ki?m tra trùng l?p (vd: "C" là c?t C)
colToCheck = "C"
' Thay ??i tên Sheet theo tên Sheet b?n ?ang làm vi?c
Set ws = ThisWorkbook.Sheets("LSVTaxTrans.ReportOutTax")
' Tìm dòng cu?i cùng có d? li?u trong c?t ki?m tra
lastRow = ws.Cells(ws.Rows.Count, colToCheck).End(xlUp).Row
' Xóa màu n?n c?a t?t c? các dòng trong Sheet tr??c khi b?t ??u ki?m tra
ws.Cells.Interior.ColorIndex = xlNone
' T?o m?t ??i t??ng Scripting.Dictionary ?? l?u tr? các giá tr? c?a c?t ki?m tra
Set dict = New Scripting.Dictionary
' L?p qua c?t ki?m tra và thêm các giá tr? vào Dictionary
For Each cell In ws.Range(colToCheck & "2:" & colToCheck & lastRow)
If Not IsEmpty(cell.Value) Then
If Not dict.Exists(cell.Value) Then
dict.Add cell.Value, cell.Row
Else
' ?ánh d?u các dòng có giá tr? trùng l?p
ws.Rows(cell.Row).Interior.Color = RGB(255, 255, 0) ' Màu vàng
ws.Rows(dict(cell.Value)).Interior.Color = RGB(255, 255, 0) ' Màu vàng
End If
End If
Next cell
End Sub
Editor is loading...