如果输入特定数字,则为单元格着色
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
- 您必须使用 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
我需要在 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
- 您必须使用 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