Question

我想要在相当大的电子表格上使用简单的颜色代码（数百个单元格可以着色）。如果我使用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

如果Jean Francois Corbett可以回答那会很棒！

Answer 1

@TimWilliams是正确的，但是，您可以反复扩展目标范围以包含target.dependants，如

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)

为：

For Each c In Intersect(TargetDependents(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

vba基于公式的条件格式

1 个答案: