excel - 过期日期超过 40 天时突出显示单元格

Question

我是 vba 的新手。希望你们能帮助我。我有一个 excelsheet，当 col J 的日期自今天起超过 40 天时，它需要 col J（出院日期 = DisDate）自动以红色突出显示。我一直试图弄清楚，但我知道我在某个地方错了。我的代码如下。

Sub highlightCell()


Dim DisDate As Range
Set DisDate = Range("J1,J3000")

For Each Cell In DisDate

If DisDate> DisDate + 40 Then
Cell.Interior.ColorIndex = 3

End If
Next
End Sub

标签： excelvbaformatexcel-2013

Answer 1

按日期突出显示

• 请注意，BigBen 在评论中涵盖了两个主要问题（范围、日期）。
• 最重要的是请注意，Ken White 的使用建议（在评论中）Conditional Formatting实际上是必须的：当那些日子过去时，Excel 将自动突出显示明天或下周变得太旧的值。
• 为了练习 VBA，请学习以下内容。

Option Explicit ' use this in each module (google it)


Sub HighlightCells()
     
    Dim dtrg As Range: Set dtrg = Range("J1:J3000") ' Date Range
    
    Dim dtCell As Range ' Date Cell
    
    For Each dtCell In dtrg.Cells
        If dtCell.Value > Date + 40 Then
            dtCell.Interior.ColorIndex = 3
        End If
    Next dtCell

End Sub


Sub HighlightCellsIssues()
     
    ' The ActiveSheet, any sheet, the selected one, the one you're looking at:
    ' could be the wrong one.
    Dim dtrg As Range: Set dtrg = Range("J1:J3000") ' Date Range
    
    ' Better
    ' By using the tab name (in 'VBE' the name in parentheses) you are
    ' specifying the exact worksheet. Someone could rename it when the code
    ' would fail.
'    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
'    Dim ws As Worksheet: Set ws = wb.Worksheets("Sheet1")
'    Dim dtrg As Range: Set dtrg = ws.Range("J1:J3000") ' Date Range
    
    ' Best
    ' By using the code name (in 'VBE' the name not in parentheses),
    ' you are specifying the exact worksheet. It is less likely that someone
    ' would change the code name when the code would fail.
'    Dim dtrg As Range: Set dtrg = Sheet1.Range("J1:J3000") ' Date Range
    
    ' To make it dynamic, you could do:
'    Dim dtrg As Range: Set dtrg = Range("J1", Range("J" & Rows.Count).End(xlUp))
    ' or (it's the same)
'    Dim dtrg As Range: Set dtrg = Range("J1", Cells(Rows.Count, "J").End(xlUp))
    ' or (it's the same)
'    Dim dtrg As Range: Set dtrg = Range("J1", Cells(Rows.Count, 10).End(xlUp))
        
    Dim dtCell As Range ' Date Cell
    
    For Each dtCell In dtrg.Cells ' adding '.Cells' is good practice
        If dtCell.Value > Date + 40 Then ' 'TODAY()' in Excel is 'Date' in VBA
            dtCell.Interior.ColorIndex = 3 ' depends on the theme
            'dtCell.Interior.Color = vbRed ' or 255; is always red
        End If
    Next dtCell ' adding 'dtCell' is good practice

End Sub


Sub TestRange()
    If ActiveSheet Is Nothing Then Exit Sub
    If Not TypeOf ActiveSheet Is Worksheet Then Exit Sub
    
    Debug.Print "Count Cells in Range"
    Debug.Print "Wrong (only the first and last)"
    Debug.Print """J1,J3000""   " & " - " & Range("J1,J3000").Cells.Count
    Debug.Print "Correct"
    Debug.Print """J1:J3000""   " & " - " & Range("J1:J3000").Cells.Count
    Debug.Print """J1"", ""J3000""" & " - " & Range("J1", "J3000").Cells.Count
    
End Sub


Sub TestEquality()
    If 1 > 1 + 40 Then
        Debug.Print "This will never happen."
    Else
        Debug.Print "This will always happen."
    End If
End Sub