根据一系列单元格中的值对文本列进行颜色编码

时间:2021-04-15 10:11:58

标签: excel vba

我希望这个宏执行两个部分。

第 1 部分:

在三个条件下跨多行(我测试了 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

第 2 部分:

我正在尝试使用上面提到的三种颜色中的任何一种颜色对人物列 (A) 进行颜色编码,最高优先级为红色。

  • 如果范围(c 到 s)中的行中的任何一个单元格为红色,则该行中的 Person 应标记为红色。
  • 如果一行中只有绿色和浅绿色,则浅绿色优先,此人应标记为浅绿色。
  • 如果所有单元格中都只有绿色,则该人应被标记为绿色。

此部分不起作用。所有单元格都以红色突出显示。

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

这是我运行上述代码时出现的问题
enter image description here

我的预期结果: enter image description here

1 个答案:

答案 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
相关问题