VBA实现距车辆年检到期不足1周时自动变更工作表标签颜色

• 未定义常量MAX_ROW，运行时会直接触发“变量未定义”报错
• 错误引用ActiveSheet取值而非事件自带的工作表对象Sh，会导致操作对象错位：哪怕触发计算的是其他工作表，也只会修改当前激活表的标签颜色
• 列引用匹配错误：代码默认取第14列（N列）内容，和实际存储到期日的M列（第13列）位置不对应
• 循环逻辑失效：每遍历一行就直接修改整个工作表的标签颜色，后一行的判断结果会完全覆盖前序结果，根本无法实现“只要存在任意一行到期临近就标红”的需求
• 空值兼容缺失：到期日列的公式生成空字符串时，强制赋值给Date类型变量会触发类型不匹配报错
• 日期判断逻辑冗余：原代码用DateSerial(Year(Date), Month(cell), Day(cell))取同年同月同日的参考值做差值，会直接漏判跨年的到期日场景

' 根据自身表格最大数据行调整对应数值即可
Const MAX_ROW As Long = 2000 

Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
    Dim i As Long
    Dim dueDate As Variant
    Dim isNearExpire As Boolean
    
    ' 跳过非车辆数据页，避免设置页、汇总页的标签被误改
    If Sh.Name = "首页" Or Sh.Name = "规则设置" Then Exit Sub
    
    ' 初始化标记为非临近到期
    isNearExpire = False
    
    ' 从第14行数据起始位置开始，遍历存放到期日的M列（第13列）
    For i = 14 To MAX_ROW
        dueDate = Sh.Cells(i, 13).Value
        ' 跳过非日期格式的空单元格，适配到期日列的公式空值场景
        If IsDate(dueDate) Then
            ' 计算到期日与今日的差值，差值小于等于7天即满足临近条件（包含已过期场景）
            If dueDate - Date <= 7 Then
                isNearExpire = True
                ' 找到符合条件的行后直接跳出循环，无需遍历剩余行提升运行效率
                Exit For
            End If
        End If
    Next i
    
    ' 根据判断结果设置标签颜色：3为红色，6为黄色
    Sh.Tab.ColorIndex = IIf(isNearExpire, 3, 6)
End Sub

• 任意工作表的到期日列触发公式计算后，自动检测该表内所有车辆的到期情况
• 只要存在1台车辆距到期不足7天（含已经过期的情况），对应工作表标签自动变为红色
• 所有车辆到期时间都在7天以上时，标签自动恢复为黄色
• 全程不需要手动逐表核查，触发工作表内容计算时自动完成颜色更新

内容的提问来源于stack exchange，提问作者Angel Picoloni