当每天通过基于日期的条件格式时如何自动更新？

Question

我是编写 VBA 代码的新手，但在过去的几周里一直在努力。

我为工作表更改事件创建了一个代码，它突出显示特定窗口中输入的某些日期，如下所示：

Private Sub Worksheet_Change(ByVal Target As Range) 
    Dim icolor As Integer 
    Dim cell As Range 
    If Intersect(Target, Range("C3:T65")) Is Nothing Then Exit Sub 
    For Each cell In Target 
        icolor = 0 
        Select Case cell 
        Case "": icolor = 2 
        Case Is <= Date + 30: icolor = 3 
        Case Is <= Date + 60: icolor = 6 
        Case Is > Date + 60: icolor = 2 
        End Select 
        If icolor <> 0 Then cell.Interior.ColorIndex = icolor 
    Next cell 
End Sub 

它完美无缺。但是，我需要电子表格基本上每天更新突出显示。 IE：如果 Date + 61 今天没有突出显示，它将在明天突出显示，因为它适合作为 Date + 60 的窗口。我怀疑一个简单的“工作表更改事件”不能做到这一点（因为它需要用户输入）。

我已尝试将其调整为工作表激活代码，以便在打开文档时可能更新突出显示（我试图避免打开工作簿，因为我将有多个工作表做不同的事情），但我无法获得它工作。关于我做错了什么的任何想法？还是有更好的方法来完成我想做的事情？

提前谢谢。

Private Sub Worksheet_Activate()
    Dim icolor As Integer
    Dim cell As Range

    If Intersect(Target, Range("C3:T65")) Is Nothing Then Exit Sub
    For Each cell In Target
        icolor = 0
        Select Case cell
            Case "": icolor = 2    
            Case Is <= Date + 30: icolor = 3
            Case Is <= Date + 60: icolor = 6
            Case Is > Date + 60: icolor = 2            
        End Select
        If icolor <> 0 Then cell.Interior.ColorIndex = icolor
    Next cell
End Sub

Answer 1

没有Target 参数传递给Worksheet_activate，所以你不能使用Intersect() 测试。你只需要直接循环你的范围

For Each cell In Me.Range("C3:T65").Cells
    'check value
Next cell 

这里最好的方法是将 hiliting 逻辑拆分为一个单独的 Sub，然后从您的事件处理程序中调用它：

编辑：添加 workbook_open

'in ThisWorkbook module
Private Sub Workbook_Open()
     Sheet1.CheckData Sheet1.Range("C3:T65")
End Sub

'in sheet code module
Private Sub Worksheet_Activate()
    CheckData Me.Range("C3:T65")
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    CheckData Intersect(Target, Me.Range("C3:T65"))
End Sub

Sub CheckData(rng As Range)
    Dim icolor As Integer
    Dim cell As Range

    If rng Is Nothing Then Exit Sub

    For Each cell In rng.Cells
        icolor = 0
        Select Case cell
            Case "": icolor = 2
            Case Is <= Date + 30: icolor = 3
            Case Is <= Date + 60: icolor = 6
            Case Is > Date + 60: icolor = 2
        End Select
        If icolor <> 0 Then cell.Interior.ColorIndex = icolor
    Next cell
End Sub