如果输入特定数字,则为单元格着色

Colour a cell if a certain number is entered

我需要在 Excel 2016 年编写条件格式,而不使用现有的条件格式设置工具。

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

范围 A1:A100:
- 如果值 >=1 则 color = green
- 如果值为 <1 或 "" 则颜色为红色

对于范围 B1:B100
- 如果值 >=3 则 color = green
- 如果值为 <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

您可以使用下面的宏。它必须放置在相应的工作表中(不是工作簿,也不是模块中)。此外,您可以通过定义 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

结束子

您需要 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 的单元格分开,因为尽管它们在所有意图和目的上都是一样的,但您以后可能想为其中一个选择不同的颜色。

将所有值设置为 vbRed 然后有选择地将大于或等于 1 的值设置为 vbGreen 可能更容易。

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
  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