Question

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

我想写这个在一个私人子目录中：

对于范围A1：A100：
-如果值> = 1，则颜色=绿色
-如果值为<1或“”，则颜色为红色

对于范围B1：B100
-如果值> = 3，则颜色=绿色
-如果值<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

您必须使用Worksheet_Change事件。您无法重命名该事件！
使用Intersect(Target, Target.Parent.Range("A:A"))仅获取A列中的单元格。
测试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的单元格分开，因为尽管它们出于所有意图和目的都是同一件事，但您将来可能希望为其中一个选择不同的颜色。

将全部设置为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

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

3 个答案: