Untitled
unknown
plain_text
2 years ago
1.4 kB
4
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...