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：如果今天没有突出显示日期+ 61，它将在明天突出显示，因为它适合日期+ 60的窗口。我怀疑一个简单的“工作表更改事件”不能这样做（因为它需要用户输入）。 / p>

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

提前致谢。

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

如何自动更新，因为每天都会根据日期传递条件格式？

1 个答案: