如果输入了某个数字，则为单元格着色

Question

我需要在 Excel 2016 中编写条件格式，而不使用现有的条件格式工具。

我想写这个，例如在私人潜艇中：

对于范围 A1:A100:
- 如果值 >=1，则颜色 = 绿色
- 如果值为

适用于范围 B1:B100
- 如果值 >=3，则颜色 = 绿色
- 如果值为 0，则颜色为黄色
- 如果值为 0 或 "" 红色

我的代码。当我保存它时，在我的第二个定义范围内没有任何反应，在重新打开 Excel 工作簿之后也是如此：

Private Sub Worksheet_Change(ByVal Target As Range)

Dim rngObserve As Range, rngCell As Range

Set rngObserve = Intersect(Target, Range("A1:A100"))

If rngObserve Is Nothing Then
    Exit Sub
End If

For Each rngCell In rngObserve.Cells
    If Not Intersect(rngCell, rngObserve) Is Nothing Then

        If rngCell.Value = vbNullString Then
            rngCell.Interior.Color = xlNone

        ElseIf rngCell.Value < 1 Then
            rngCell.Interior.ColorIndex = 3 'red

        ElseIf rngCell.Value >= 1 Then
            rngCell.Interior.ColorIndex = 4 'green

        Else
            rngCell.Interior.ColorIndex = 3
        End If
    End If
Next

Set rngObserve = Intersect(Target, Range("B1:B100"))

If rngObserve Is Nothing Then
    Exit Sub
End If

For Each rngCell In rngObserve.Cells

    If Not Intersect(rngCell, rngObserve) Is Nothing Then

        If rngCell.Value = vbNullString Then
            rngCell.Interior.Color = xlNone

        ElseIf rngCell.Value < 1& > 0 Then
            rngCell.Interior.ColorIndex = 6 'yellow

        ElseIf rngCell.Value >= 3 Then
            rngCell.Interior.ColorIndex = 4 'green

        Else
            rngCell.Interior.ColorIndex = 3

        End If
    End If
Next

End Sub

Answer 1

1. 您必须使用 Worksheet_Change 事件。您不能重命名该活动！
2. 使用Intersect(Target, Target.Parent.Range("A:A")) 仅获取A 列中的单元格。
3. 测试Target 中的每个单元格值是否是数字If IsNumeric(Cell.Value) Then，以确保它仅适用于数字值！

所以你最终会得到类似的东西：

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim MyPlage  As Range
    Set MyPlage = Intersect(Target, Target.Parent.Range("A:A"))

    If Not MyPlage Is Nothing Then
        Dim Cell As Range
        For Each Cell In MyPlage
            If Cell.Value = vbNullString Then
                Cell.Interior.ColorIndex = 3 'red
            ElseIf IsNumeric(Cell.Value) Then
                If Cell.Value < 1 Then
                    Cell.Interior.ColorIndex = 3 'red
                Else
                    Cell.Interior.ColorIndex = 4 'green
                End If
            End If
        Next Cell
    End If
End Sub

Answer 2

您可以使用以下宏。它必须放在相应的工作表中（不是工作簿，也不是模块）。此外，您可以通过定义 rngObserve 来定义要观察的范围）。我猜你不想检查整个工作表...

Private Sub Worksheet_Change(ByVal Target As Range)

Dim rngObserve As Range, rngCell As Range

Set rngObserve = Intersect(Target, Range("A1:C5"))

If rngObserve Is Nothing Then
    Exit Sub
End If
For Each rngCell In rngObserve.Cells
    If Not Intersect(rngCell, rngObserve) Is Nothing Then
        If rngCell.Value = vbNullString Then
            rngCell.Interior.Color = xlNone
        ElseIf rngCell.Value < 1 Then
            rngCell.Interior.ColorIndex = 3
        ElseIf rngCell.Value >= 1 Then
            rngCell.Interior.ColorIndex = 4
        Else
            rngCell.Interior.ColorIndex = 3
        End If
    End If
Next

结束子

Answer 3

您需要Range("A:A")，但如果将其缩减到工作表的 UsedRange 属性中的单元格会更好。此外，空白单元格的值被视为零，因此应首先检查条件。

dim MyPlage As Range, cell as range

Set MyPlage = intersect(activesheet.Range("A:A"), activesheet.UsedRange)

For Each Cell In MyPlage

    If isempty(cell) then
        Cell.Interior.ColorIndex = 3 'red
    elseIf Cell.Value < 1 Then
        Cell.Interior.ColorIndex = 3 'red
    ElseIf Cell.Value >= 1 Then
        Cell.Interior.ColorIndex = 4 'green
    end if

Next cell

我已将空单元格和值小于 1 的单元格分开，因为尽管它们的所有意图和目的都是相同的，但将来您可能希望为其中一个选择不同的颜色。

将 all 设置为 vbRed 然后选择性地将大于或等于 1 的值设置为 vbGreeen 可能更容易。

dim MyPlage As Range, cell as range

Set MyPlage = intersect(activesheet.Range("A:A"), activesheet.UsedRange)

MyPlage.Interior.ColorIndex = 3 'red 

For Each Cell In MyPlage

    If  Cell.Value >= 1 Then
        Cell.Interior.ColorIndex = 4 'green
    end if

Next cell