Question

我一直在寻找类似的主题，但无法找到解决问题的正确方法。

目的：
我有一份excel表格，其中我提供了有关我的工作研究的数据： - 公司，工作职位，申请发送日期，......，最后是申请日期和今天之间的天数。

我想要一个宏来检查每个位置等待的天数（第I列中的值）并有条件地将颜色应用于整行。通过这种方式，我可以对我的工作研究有一个很好的跟进。

使用的代码

Sub outofdate()
Range("I4").Select
Range(Selection, Selection.End(xlDown)).Select
numrow = Selection.Rows.Count

For r = 4 To numrow
    c = Cells(r, 9).Value
    Select Case c
           Case Is = 7 < c < 10
           ColorIndex = 4
           Case Is = 10 < c < 15
           ColorIndex = 45
           Case Is = 15 < c < 21
           ColorIndex = 3

    End Select 'c

    With Range(Cells(r, 1), Cells(r, 9)).Select
        Selection.Interior.Color = ColorIndex
    End With
Next
End Sub

面临的问题
当我运行宏时，A4：I12范围内的单元格都是黑色的，即使我没有设置黑色的颜色索引。

谢谢你的时间，我一直想弄清楚出了什么问题，但我的知识似乎就此止步了。

Answer 1

我使用if和else if而不是select case

    Sub outofdate()


    Dim numrow As Long

    numrow = ActiveSheet.Range("I" & Rows.Count).End(xlUp).Row

    For r = 4 To numrow
    c = Cells(r, 9).Value


    If c > 7 And c < 10 Then

         Cells(r, 9).EntireRow.Interior.ColorIndex = 4

    ElseIf c > 10 And c < 15 Then

          Cells(r, 9).EntireRow.Interior.ColorIndex = 45

    ElseIf c > 15 And c < 21 Then

        Cells(r, 9).EntireRow.Interior.ColorIndex = 3

    End If

   Next

    End Sub

Answer 2

问题在于，如果黑色代码为零，并且您的颜色变量从未从零改变，那么它将为您提供黑色。也是＆＃34; Select Case＆＃34;工作不正常。

Sample for Select Case

Option Explicit

Sub outofdate()

    Dim rWorkRange As Range
    Dim r As Range
    Dim lColorIndex As Long
    Dim lValue As Long

    ' Set the range for the loop.
    Set rWorkRange = Range(Range("I4"), Range("I4").End(xlDown))

    ' Loop through the range.
    For Each r In rWorkRange

        lValue = r.Value

        ' Select each case, make sure that the else sets the
        ' lColorIndex variable to the default "0"
        Select Case lValue
            Case 7 To 10
                lColorIndex = 4
            Case 10 To 15
                lColorIndex = 45
            Case 15 To 21
                lColorIndex = 3
            Case Else
                lColorIndex = 0
        End Select

        ' Check for the "0" value (This is the black color)
        ' if the lColorIndex is zero then skip.
        If Not lColorIndex = 0 Then
            Cells(r.Row, 1).Resize(, 9).Interior.ColorIndex = lColorIndex
        End If
    Next r

End Sub

希望这有帮助:)

条件格式化行VBA

2 个答案: