Проверьте наличие дубликатов в столбце и, если есть, проверьте цвет ячейки справа от дубликатов.

Question

Мне нужна программа для проверки столбцов на наличие дубликатов, и если она есть, я хочу, чтобы она проверяла цвет ячейки справа от нее. если цвет оранжевый, я хочу изменить его на красный, а если он зеленый, я хочу его игнорировать.

    Dim lastRow As Integer, num As Integer, i As Integer

    lastRow = Range("A65000").End(xlUp).Row
    For i = 2 To lastRow
        If Not IsEmpty(Cells(i, 1)) Then
            num = WorksheetFunction.Match(Cells(i, 1), Range("A1:A" & lastRow), 0)
        End If
        If i = num Then
            If Cells(i, 2).Interior.ColorIndex = 44 Then
                Cells(i, 2).Interior.ColorIndex = 3
            End If
        End If
    Next

Это моя текущая попытка, однако этот код проверяет только наличиев первый раз дубликат появляется и игнорирует остальные. Следующая картинка покажет вам, что у меня есть, что делает код и что я хочу соответственно. Я надеюсь, что с этим вопросом все в порядке, извините, если мне кажется, что я невежественен, и большое спасибо за помощь заранее.

Answer 1

РЕДАКТИРОВАТЬ: немного сложнее, поскольку вам может потребоваться «вернуться» и раскрасить предыдущий ряд ...

Sub Tester()

    Dim lastRow As Long
    Dim sht As Worksheet, rng As Range
    Dim dict As Object, v, c As Range, c2 As Range

    Set dict = CreateObject("scripting.dictionary")

    With ActiveSheet  'always use a worksheet reference...
        Set rng = .Range("A1:A" & .Cells(.Rows.Count, 1).End(xlUp).Row)
    End With

    For Each c In rng.Cells
        v = c.Value
        Set c2 = c.Offset(0, 1)

        'potential row to recolor (orange)?
        If Len(v) > 0 And c2.Interior.ColorIndex = 44 Then

            If dict.exists(v) Then
                'is there a previous cell to color?
                If Not dict(v) Is Nothing Then
                    dict(v).Interior.ColorIndex = 3 'color the previous one
                    Set dict(v) = Nothing           'clear previous
                End If
                c2.Interior.ColorIndex = 3          'color the current one
            Else
                Set dict(v) = c2 'first orange one - remember it
            End If

        End If
    Next c

End Sub