Untitled

mail@pastecode.io avatar
unknown
plain_text
a year ago
1.4 kB
1
Indexable
Never


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