0

我想要一个相当大的电子表格上的简单颜色代码（数百个单元格要着色）。如果我使用 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）能回答那就太好了！

4

1 回答 1

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
于 2013-01-30T04:04:50.110 回答