Условное форматирование Excel vba с использованием динамического цветового ключа

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

Цветовой ключ - это одиночная столбчатая диаграмма с цветными ячейками, содержащими текст в каждой строке (например, синяя ячейка с "синим" в качестве текста).

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

Это сэкономит много времени, так как цветов много, и они должны точно соответствовать RGB.

Вот что у меня так далеко:

Sub ColorCode()

'Applies conditional formatting to Input Chart using the Color Key

Application.ScreenUpdating = False

Dim ColorKey As Range

Set ColorKey = Worksheets(2).Range("C6:C19")

Dim kCell As Object
Dim lCell As Object
Dim mCell As Object

With Worksheets(2)
    For Each mCell In Worksheets(2).Range("Input[Duration1]")
        If mCell.Value <> "0" Then
            For Each lCell In Worksheets(2).Range("Input[Color1]")
                If lCell.Value <> "" Then
                    For Each kCell In ColorKey.Cells
                        If lCell.Value = kCell.Value Then
                            mCell.Interior.Color = kCell.Interior.Color
                            mCell.Font.Color = kCell.Font.Color
                        End If
                    Next
                End If
            Next
        End If
    Next
End With

Это проходит по каждой ячейке в столбцах и фактически окрашивает их. Проблема в том, что все ячейки окрашены в соответствии с состоянием последней ячейки, поэтому все цвета одинаковы, а не каждая ячейка форматируется для своей собственной состояние.

Перед добавлением "application.screenupdating=false" Я вижу, как цвета мерцают во время зацикливания, но они просто не будут прилипать. Когда я пытаюсь добавить "ByVal Target as Range" в моем коде мой макрос исчезает, и, честно говоря, хотя я посмотрел это вверх, я не очень понимаю, что это значит.

Я новичок в VBA, и я почти уверен, что упускаю что-то простое. Буду очень признателен за любую помощь в этом!

Я отмечаю это как ответ - вот обновленный код!

Sub getcol()

Dim rr As Range
Dim tg  As Range

    Set color_dict = CreateObject("Scripting.Dictionary"

        For Each rr In Range("colorkey")
            color_dict.Add rr.Text, rr.Interior.Color
        Next


        For Each rr In Range("input[color1]")
            rr.Offset(0, -2).Interior.Color = color_dict(rr.Text)

        Next

        End Sub

1 ответ

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

Но в любом случае, вы, вероятно, хотите создать dictionary хранить цвета против text ключ. А затем используйте этот словарь для циклического перебора целевого диапазона и установки цвета ячейки, читая текст в этой целевой ячейке (??)

ниже я предполагаю, что текст для создания словарного ключа находится в столбце рядом с диапазоном color_key, Если текст, который вы хотите прочитать для создания ключа словаря, фактически находится в том же столбце, удалите offset (или установите его в 0 смещений столбцов).

Я предполагаю что color_key а также target_Range именованные диапазоны в ваших листах Excel (где-то).

Sub getcol()

Dim rr As Range
Set color_dict = CreateObject("Scripting.Dictionary")

 For Each rr In Range("color_key")
    color_dict.Add rr.Offset(0, 1).Text, rr.Interior.Color
 Next

 For Each rr In Range("target_Range")
    rr.Interior.Color = color_dict(rr.Text)
 Next

End Sub

Код CELL.Interior.Color возвращает целочисленный код, представляющий цвет заливки ячейки, поскольку вы упомянули, что вам нужен точно такой же цвет.

Словарь dict работает путем чтения пар (ключ, значение) с использованием синтаксиса dict.Add key, value, И возвращает значение, когда ему передается соответствующий ключ: dict(key)=value,

Другие вопросы по тегам