根据单元格值vba更改行背景颜色

时间:2016-02-25 08:12:36

标签: excel vba excel-vba

我想更改行背景颜色,如果日期是今天(日期在列A中以A7开头)但它不起作用。欢迎任何帮助。谢谢。

Sub Update_Row_Colors()
   Dim LRow As Integer
   Dim LCell As String
   Dim LColorCells As String
   LRow = 7
   While LRow < 50
      LCell = "A" & LRow
      'Color will changed in columns A to AM
      LColorCells = "A" & LRow & ":" & "AM" & LRow
      Select Case Left(Range(LCell).Value, 6)
         Case Now
            Range(LColorCells).Interior.ColorIndex = 34
            Range(LColorCells).Interior.Pattern = xlSolid
         Case Else
            Rows(LRow & ":" & LRow).Select
            Range(LColorCells).Interior.ColorIndex = xlNone
          End Select
          LRow = LRow + 1
   Wend
End Sub

2 个答案:

答案 0 :(得分:2)

我认为问题在于你使用Now来返回当前的日期时间,而你却想把它与日期进行比较。尝试更改:

Case Now

Case Date()

答案 1 :(得分:1)

您可以使用日期作为@Wouter提及。

您还需要将Left(Range(LCell).Value, 6)更改为Left(Range(LCell).Value, 10)

如果您想使用Now,则还需要使用Left功能从Now值中删除时间。

请参阅下面的工作答案。

另外请记住,在想要标注变量以引用LongRow

时,请始终使用Column
 Sub Update_Row_Colors()

      'Always want to use a long for referencing a Row or Column
      Dim LRow As Long
      Dim LCell As String
      Dim LColorCells As String

      LRow = 7

      While LRow < 50

           LCell = "A" & LRow
           'Color will changed in columns A to AM
           LColorCells = "A" & LRow & ":" & "AM" & LRow

           Select Case Left(Range(LCell).Value, 10)
           Case Left(Now, 10)
                Range(LColorCells).Interior.ColorIndex = 34
                Range(LColorCells).Interior.Pattern = xlSolid
           Case Else
                Rows(LRow & ":" & LRow).Select
                Range(LColorCells).Interior.ColorIndex = xlNone
           End Select

           LRow = LRow + 1
      Wend
 End Sub

只需添加一些信息,您可以更好地使用Range缩短/清理代码,请参阅下文。

我已经添加了一行来检查已使用的行,请注意,即使Row中有空格,也会计算它。

 Option Explicit

 Sub Update_Row_Colors()

      Dim LRow As Long
      Dim RowRange As Range

      Dim LastRow As Long
      LastRow = ActiveSheet.Range("A1").SpecialCells(xlCellTypeLastCell).Row

      For LRow = 7 To LastRow

           Set RowRange = Range(Cells(LRow, "A"), Cells(LRow, "AM"))

           If Left(Cells(LRow, "A").Value, 10) = Left(Now, 10) Then
                RowRange.Interior.ColorIndex = 34
                RowRange.Interior.Pattern = xlSolid
           Else
                RowRange.Interior.ColorIndex = xlNone
           End If

      Next LRow
 End Sub