使用 VBA 的条件格式，通过引用另一个单元格来动态设置范围的格式答案

【问题标题】：Conditional Formatting using VBA, Dynamically styling a range by referring to another cell for the formatting使用 VBA 的条件格式，通过引用另一个单元格来动态设置范围的格式
【发布时间】：2014-10-24 23:25:50
【问题描述】：

这是我的问题。

因此，应用于K3:K10 范围，我有几个不同的条件格式规则，这些规则需要一个特定的文本字符串，该字符串由引用单元格的内容加上一个常量文本字符串组成。每个规则为特定引用的单元格和常量文本字符串（DEAD 或 ALIVE）组合应用不同的颜色。例如，在区域中，如果一个单元格包含单词“Dog”，然后是一个空格，然后是单词“Dead”，它将被格式化为红色。 D 和 E 列中的图例显示了针对标准组合（动物和死/活）适用于每种动物的颜色。我想要做的是，能够通过C 列中的下拉列表为动物选择一种颜色，并让 CF 更改K3:K10 范围内任何单元格的格式以匹配格式当特定规则为真时，C 列中相关行的 /style。

因此，如果K3 是“Dog Dead”，则应用与单元格D3 相同的格式，或者如果它是“Dog Alive”，则应用与E3 相同的格式。我不想只要求 CF 将任何包含“Dog Dead”红色或“Dog Alive”的单元格设为浅红色，因为 dog 的颜色可能不是红色。它可以是绿色或蓝色。

所以，我想我想使用 VBA 实现动态条件格式。有人可以帮我开始吗？

谢谢，

安迪。

【问题讨论】：

标签： excel vba dynamic formatting conditional

【解决方案1】：

起点！！
在工作表事件中：

Private Sub Worksheet_Change(ByVal Target As Range)
    ApplyCond Range("K" & Target.Row)
End Sub

在一个模块中：

Public Sub ApplyCond(xx As Range)
    If xx.Value = "" Then Exit Sub
    xx.FormatConditions.Delete
    xx.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
        Formula1:=xx.Value
    kk = Split(xx.Value)
    a = -1
    b = -1
    For i = LBound(kk) To UBound(kk)
        Select Case kk(i)
        Case "Dead": a = 4
        Case "Alive": a = 5
        Case Else
            For e = 3 To 9999
                If Range("B" & e).Value = "" Then Exit For
                If Range("B" & e).Value = kk(i) Then
                    b = e
                End If
            Next
        End Select
    Next

    ' Apply Format
    On Error Resume Next
    If (a > 0) And (b > 0) Then
        With xx.FormatConditions(1).Interior
            .PatternColorIndex = Cells(b, a).Interior.PatternColorIndex
            .Color = Cells(b, a).Interior.Color
            .TintAndShade = Cells(b, a).Interior.TintAndShade
            .Pattern = Cells(b, a).Interior.Pattern
            .PatternThemeColor = Cells(b, a).Interior.PatternThemeColor
            .ThemeColor = Cells(b, a).Interior.ThemeColor
            .PatternTintAndShade = Cells(b, a).Interior.PatternTintAndShade
        End With
        With xx.FormatConditions(1).Font
            .Bold = Cells(b, a).Font.Bold
            .Italic = Cells(b, a).Font.Italic
            .Underline = Cells(b, a).Font.Underline
            .Strikethrough = Cells(b, a).Font.Strikethrough
            .ThemeColor = Cells(b, a).Font.ThemeColor
            .TintAndShade = Cells(b, a).Font.TintAndShade
            .Color = Cells(b, a).Font.Color
            .TintAndShade = Cells(b, a).Font.TintAndShade
        End With
    End If
End Sub

您需要验证拆分公式。也许使用 LCase 函数或其他过滤器会更好。
在我的函数中，我不使用“C”列。

【讨论】：