基于公式的vba条件格式

我想要一个相当大的电子表格（数百个单元格的颜色）上的简单颜色代码。如果我使用CF，它会减慢计算机速度，Excel就会崩溃。 我想试着用VBA来做。 我尝试了下面的代码，但它只在我键入值（1、2或3）时起作用。如果该值是公式的结果，则不起作用。 有什么想法吗

Private Sub Worksheet_Change(ByVal Target As Range)

Dim icol As Integer, c As Range, rng As Range

If Target.Count > 1 Then Exit Sub

Set rng = Range("D2:s1000")

If Intersect(Target, rng) Is Nothing Then Exit Sub

For Each c In Intersect(Target, rng)

    Select Case UCase(c.Value)
        Case 1: icol = 3
        Case 2: icol = 4
        Case 3: icol = 18
        Case Else: icol = 0
    End Select
    c.Interior.ColorIndex = icol
Next c
End Sub

---

如果让·弗朗索瓦·科贝特能回答这个问题，那就太好了

@TimWilliams是正确的，但是，您可以重新扩展目标范围以包括target.dependent，如

Private Function TargetDependents(ByRef Target As Range) As Range
    Dim c As Range

    If Not Target.Dependents Is Nothing Then
        Set TargetDependents = Union(Target, Target.Dependents)
    End If

    If TargetDependents.Cells.Count > Target.Cells.Count Then
        TargetDependents = TargetDependents(TargetDependents)
    End If
End Function

改变这一点：

For Each c In Intersect(Target, rng)

致：

更新作为对注释的响应，编辑的代码应该如下所示

Private Function TargetDependents(ByRef Target As Range) As Range
    Dim c As Range

    If Not Target.Dependents Is Nothing Then
        Set TargetDependents = Union(Target, Target.Dependents)
    End If

    If TargetDependents.Cells.Count > Target.Cells.Count Then
        TargetDependents = TargetDependents(TargetDependents)
    End If
End Function

Private Sub Worksheet_Change(ByVal Target As Range)

Dim icol As Integer, c As Range, rng As Range

If Target.Count > 1 Then Exit Sub

Set rng = Range("D2:s1000")

For Each c In Intersect(TargetDependents(Target), rng)

    Select Case UCase(c.Value)
        Case 1: icol = 3
        Case 2: icol = 4
        Case 3: icol = 18
        Case Else: icol = 0
    End Select
    c.Interior.ColorIndex = icol
Next c
End Sub

---

我不是JFC，所以也许我不应该回答，但工作表的更改不是由重新计算触发的。您也可以尝试处理工作表\u Calculate事件：它确实需要更多的工作，因为在该事件中没有“目标”范围可检查。我刚从休假回来，看到了您的答复。很抱歉，如果我给人的印象是我理解上面粘贴的代码，我不。。。这就是为什么我不知道如何包含您善意提供的更改。如果你们中有人能让我知道如何让这段代码工作，那将是一个巨大的帮助：）谢谢Dale，现在我得到一个错误：它没有突出显示任何内容，并说：编译错误：object的使用无效。第3行：如果Target.Dependents不是什么，那么太多vb.net了<代码>如果目标。依赖项不是空的，则应该是

如果不是目标。依赖项是空的，则

。Will editHi Dale，现在它说运行时错误“1004”没有找到单元格。如果我按Debug，您编辑的行将高亮显示。

Private Function TargetDependents(ByRef Target As Range) As Range
    Dim c As Range

    If Not Target.Dependents Is Nothing Then
        Set TargetDependents = Union(Target, Target.Dependents)
    End If

    If TargetDependents.Cells.Count > Target.Cells.Count Then
        TargetDependents = TargetDependents(TargetDependents)
    End If
End Function

Private Sub Worksheet_Change(ByVal Target As Range)

Dim icol As Integer, c As Range, rng As Range

If Target.Count > 1 Then Exit Sub

Set rng = Range("D2:s1000")

For Each c In Intersect(TargetDependents(Target), rng)

    Select Case UCase(c.Value)
        Case 1: icol = 3
        Case 2: icol = 4
        Case 3: icol = 18
        Case Else: icol = 0
    End Select
    c.Interior.ColorIndex = icol
Next c
End Sub