使用动态颜色键的 Excel vba 条件格式

Question

我正在尝试创建一个 Excel 宏，它使用另一列中单元格的条件和另一列中单元格的格式（本质上是颜色键）将条件格式应用于目标列。

颜色键是单个柱形图，每行包含包含文本的彩色单元格（例如，带有“蓝色”作为文本的蓝色单元格）。

目标是能够更改颜色键中的填充颜色或文本，并让目标单元格自动更改为新的颜色或条件，而无需通过 Excel 的条件格式规则管理器对新的 RGB 进行硬编码。

这会节省很多时间，因为有很多颜色，而且它们必须是完全匹配的 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

Answer 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。