我希望这个宏执行两个部分。
在三个条件下跨多行(我测试了 47 行)从 C 到 S 的颜色代码单元格。
CELL has value between 1 & 39 = Light Green
CELL has value > 40 = Red
CELL has value = 40 = Dark Green
注意 ** 该段有效。单元格显示正确的颜色。
Sub Macro5()
Range("C2:S47").Select
Selection.formatconditions.Delete
Selection.formatconditions.Add Type:=xlCellValue, Operator:=xlBetween, _
Formula1:="1", Formula2:="39"
Selection.formatconditions(1).Interior.ColorIndex = 35
Selection.formatconditions.Add Type:=xlCellValue, Operator:=xlGreater, _
Formula1:="40"
Selection.formatconditions(2).Interior.ColorIndex = 3
Selection.formatconditions.Add Type:=xlCellValue, Operator:=xlEqual, _
Formula1:="40"
Selection.formatconditions(3).Interior.ColorIndex = 10
End Sub
我正在尝试使用上面提到的三种颜色中的任何一种颜色对人物列 (A) 进行颜色编码,最高优先级为红色。
此部分不起作用。所有单元格都以红色突出显示。
Sub color_cells()
Dim i As Long, r1 As Range, r2 As Range
Set r2 = Range("A2:A10")
Set r1 = Range("C2:S47")
For Each cell In r1
If IsEmpty(cell) Then GoTo nextcell:
If cell.Value > 40 Then r2.Interior.Color = vbRed Else
If cell.Value = 40 Then r2.Interior.Color = vbGreen Else
If cell.Value >= 0 And cell.Value <= 39 Then r2.Interior.Color = vbCyan
nextcell:
Next cell
End Sub
答案 0 :(得分:0)
尽量让你的代码完全合格,避免使用 select
Sub Macro5()
Dim formatRange As Range
Set formatRange = Sheet1.Range("C2:S47") 'Change the worksheet name to the correct one
With formatRange.FormatConditions
.Delete
.Add Type:=xlCellValue, Operator:=xlBetween, Formula1:="1", Formula2:="39"
.Item(1).Interior.ColorIndex = 35
.Add Type:=xlCellValue, Operator:=xlGreater, Formula1:="40"
.Item(2).Interior.ColorIndex = 3
.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:="40"
.Item(3).Interior.ColorIndex = 10
End With
End Sub
至于您的第二部分:
Sub color_cells()
Dim i As Long
Dim n As Long
Dim cellColor As Long
Dim capArr() As Variant
Const rowStart As Long = 2
Const rowEnd As Long = 10
Const colStart As Long = 3 'C
Const colEnd As Long = 19 'S
With Sheet1 'Change the worksheet name to the correct one
For i = rowStart To rowEnd 'Loop through your rows
'Double tranpose needed to get a row of value into 1D array
capArr = Application.Transpose(Application.Transpose(.Range(.Cells(i, colStart), .Cells(i, colEnd)).Value))
cellColor = vbGreen
For n = 1 To UBound(capArr)
Select Case capArr(n)
Case 1 To 39:
cellColor = vbCyan
Case Is > 40 'Since you found a cell that's red, you can exit the loop straight away
cellColor = vbRed
Exit For
End Select
Next n
.Cells(i, 1).Interior.Color = cellColor
Next i
End With
End Sub