Выделите повторяющиеся ячейки между несколькими диапазонами, но не в пределах диапазонов

Question

Диапазон A - это B1: E2000 (на самом деле это должно быть B1: B500, C1: C1000, D1: D1500, E1: E2000).

Диапазон B - это G1: G2000.

Диапазон C равен I1: AH2000.

Шаг 1. Если ячейка отображается в диапазоне А и диапазоне C, я хочу, чтобы они были выделены желтым цветом.

Шаг 2. Затем, если ячейка появляется в диапазоне A и диапазоне B, я хочу, чтобы они были выделены зеленым цветом. Предполагается, что это может подсвечивать ячейки, уже выделенные желтым на шаге 1.

Шаг 3: Затем, если ячейка появляется в диапазоне B и более двух раз в диапазоне C, я хочу, чтобы они были выделены красным цветом. Предполагается, что это может выделить ячейки, уже выделенные желтым цветом на шаге 1 или зеленым цветом на шаге 2.

Шаг 4: В противном случае ячейка не должна выделяться. Если в выделенной ячейке есть текст, который позже удаляется, то при повторном запуске макроса я бы хотел, чтобы пустая ячейка была не выделена.

Мне не нужны дубликаты в сами диапазоны.

Я могу почти выяснить это в условном форматировании, но CF "изменчив", и я хочу избегать лагов каждый раз, когда пытаюсь прокрутить (хотя это тоже частично из-за того, что мой CF ужасно неэффективен), поэтому я более чем счастлив использовать макрос VBA для его запуска, когда мне это нужно. (Конечно, если - это лучший способ сделать это с помощью условного форматирования, я не собираюсь говорить нет.)

Если вы действительно хотите увидеть мою ужасную и хакерскую попытку объединяя код, который я нашел для похожих результатов, пусть будет так:

Sub HighlightDuplicates()

    Dim cells As Range
    Dim cell As Range
    Set cells = Range("B1:AH2000")

    For Each cell In cells
        If WorksheetFunction.CountIf(cells, cell.Value) > 3 Then
            cell.Interior.ColorIndex = 3
        ElseIf WorksheetFunction.CountIf(cells, cell.Value) > 2 Then
            cell.Interior.ColorIndex = 4
        ElseIf WorksheetFunction.CountIf(cells, cell.Value) > 1 Then
            cell.Interior.ColorIndex = 6
        Else
            cell.Interior.ColorIndex = 0
        End If
    Next cell

End Sub

Понятно, что у меня нет четкого представления о том, что я делаю, и я не смог бы ради своей жизни выяснить, как работать в нескольких диапазонах. Очевидно, он не работает так, как задумано. Кроме того, это проверяет каждую ячейку на предмет каждой ячейки, что, очевидно, ужасно неэффективно для того, что я пытаюсь сделать.

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

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

Answer 1

См. Словарь объекта

Option Explicit
Sub HighlightDuplicates()

    Dim ws As Worksheet, t0 As Single, t1 As Single
    Set ws = ThisWorkbook.Sheets("Sheet1")
    t0 = Timer

    'Step 4: Otherwise, a cell should not be highlighted.
    ws.Cells.ClearFormats

    Const RANGE_A As String = "B1:E2000"
    Const RANGE_B As String = "G1:G2000"
    Const RANGE_C As String = "I1:AH2000"

    Dim dictA As Object, dictB As Object, dictC As Object
    Set dictA = CreateObject("Scripting.Dictionary")
    Set dictB = CreateObject("Scripting.Dictionary")
    Set dictC = CreateObject("Scripting.Dictionary")

    Call buildDict(dictA, ws.Range(RANGE_A))
    Call buildDict(dictB, ws.Range(RANGE_B))
    Call buildDict(dictC, ws.Range(RANGE_C))

    'Step 1: If a cell appears in Range A and Range C highlighted yellow.
    'Step 2: Then, if a cell appears in Range A and Range B,
     'I want them highlighted green.
    Dim cell As Range, key As String
    For Each cell In ws.Range(RANGE_A)
        If Len(cell.Value) > 0 Then
            key = CStr(cell.Value)
            If dictC.exists(key) Then cell.Interior.Color = vbYellow
            If dictB.exists(key) Then cell.Interior.Color = vbGreen
        End If
    Next

    For Each cell In ws.Range(RANGE_C)
        If Len(cell.Value) > 0 Then
            key = CStr(cell.Value)
            If dictA.exists(key) Then cell.Interior.Color = vbYellow
        End If
    Next

    For Each cell In ws.Range(RANGE_B)
        If Len(cell.Value) > 0 Then
            key = CStr(cell.Value)
            If dictA.exists(key) Then cell.Interior.Color = vbGreen
        End If
    Next

    'Step 3: Then, if a cell appears in Range B and more than twice in Range C,
    'I want them highlighted red.

    For Each cell In ws.Range(RANGE_B)
        If Len(cell.Value) > 0 Then
            key = CStr(cell.Value)
            If dictC.exists(key) Then
                If dictC.Item(key) > 2 * dictB.Item(key) Then
                    cell.Interior.Color = vbRed
                End If
            End If
        End If
    Next

    For Each cell In ws.Range(RANGE_C)
        If Len(cell.Value) > 0 Then
            key = CStr(cell.Value)
            If dictB.exists(key) Then
                If dictC.Item(key) > 2 * dictB.Item(key) Then
                    cell.Interior.Color = vbRed
                End If
            End If
        End If
    Next
    t1 = Timer
    MsgBox "Completed in " & Int(t1 - t0) & " seconds"

End Sub

Sub buildDict(ByRef dict, ByRef rng)

    Dim cell As Range, key As String
    For Each cell In rng
        If Len(cell.Value) > 0 Then
            key = CStr(cell.Value)
            If Not dict.exists(key) Then
                dict.Add key, 1
            Else
                dict.Item(key) = dict.Item(key) + 1
            End If
        End If
    Next
    Debug.Print "Keys in " & rng.Address, dict.Count

End Sub