Excel VBA仅高亮当日日期所在列 清除过往日期列填充色

• 现有VBA可在工作簿打开时定位当日日期列并填充浅蓝色背景，但存在两处明显缺陷：
  • 未清除历史日期列的同色填充，导致多列同时高亮，不符合仅高亮当日列的预期
  • 日期查找结果的空判断逻辑顺序错误，找不到对应日期时会直接触发运行时报错
• 目标效果：打开工作簿后仅保留当日日期所在列的蓝色填充，自动清除其余列的同色填充，同时自动滚动视图定位到当日列位置

核心逻辑调整：优先清除指定范围内的历史高亮填充，再执行当日列的查找、高亮、定位操作，同时修正空判断的执行顺序。

修正后完整代码 #

Private Sub Workbook_Open()
    Dim CellToShow As Range
    Dim ws As Worksheet
    Dim targetColor As Long
    Dim x As Integer
    
    ' 基础配置
    Set ws = ThisWorkbook.Worksheets("Sheet2")
    targetColor = RGB(151, 228, 255)
    x = Day(Date)
    
    ws.Select
    ' 第一步：清除已使用区域的所有填充色，避免历史高亮残留
    ' 仅操作已使用区域，避免全表清空影响性能
    ws.UsedRange.Interior.ColorIndex = xlNone
    
    ' 在第3行查找当日日期，匹配整值避免错配（如找1号时匹配到11、21号）
    Set CellToShow = ws.Rows(3).Find(What:=x, LookIn:=xlValues, LookAt:=xlWhole)
    
    If CellToShow Is Nothing Then
        MsgBox "No Cell for day " & x & " found.", vbCritical
    Else
        ' 给当日列设置目标填充色
        CellToShow.EntireColumn.Interior.Color = targetColor
        ' 滚动窗口定位到目标单元格
        With CellToShow
            .Select
            .Show
        End With
    End If
End Sub

可选优化 #

如果工作表其他区域也使用了RGB(151, 228, 255)这个浅蓝色，不想被全局清空操作误删，可以把全局清空填充的代码替换为定向清除逻辑，仅清除第3行日期对应的列填充：

' 替换上述代码中ws.UsedRange.Interior.ColorIndex = xlNone部分
Dim dateCell As Range
For Each dateCell In Intersect(ws.Rows(3), ws.UsedRange)
    If VBA.IsNumeric(dateCell.Value) Then
        dateCell.EntireColumn.Interior.ColorIndex = xlNone
    End If
Next

内容的提问来源于stack exchange，提问作者Nik Ge