Excel日期差校验VBA代码咨询：工作日差≥4时触发输入重置

原代码存在的问题 #

• 逻辑判断完全颠倒：原代码中If Range("L4") >= 4 Then Exit Sub的逻辑是当工作日差≥4时直接退出，不执行提示，和需求中「L4≥4时弹窗提示并要求重新输入」的要求完全相反。
• 未实现J2自动设置为今日日期的功能：原代码没有处理J2的初始化逻辑，无法满足需求第一条。
• 未确保L4的公式有效性：依赖手动添加公式，若用户未设置则整个功能失效。
• 事件触发范围无限制：任何单元格变动都会触发事件，存在冗余执行的问题。
• 未恢复事件触发状态：Application.EnableEvents = False后未重置为True，会导致后续工作表事件无法正常触发。

修正后的代码 #

Private Sub Worksheet_Activate()
    ' 工作表激活时自动设置J2为今日日期，确保每次切换到该表时日期最新
    Range("J2").Value = Date
    ' 强制设置L4的计算公式，避免手动操作遗漏
    Range("L4").Formula = "=NETWORKDAYS(J2,J4)-1"
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    ' 仅当修改的是J4单元格时才执行逻辑，减少冗余触发
    If Not Intersect(Target, Range("J4")) Is Nothing Then
        Application.EnableEvents = False
        
        ' 强制计算L4的值，确保J4修改后立即得到最新工作日差
        Range("L4").Calculate
        
        ' 按需求判断工作日差
        If Range("L4").Value >= 4 Then
            ' 依次弹出提示框
            MsgBox "Application takes at least 4-7 working days", vbOKOnly, "Reminder"
            MsgBox "Please pick another date", vbOKOnly
            ' 清空J4并定位到该单元格
            Range("J4").ClearContents
            Range("J4").Select
        End If
        
        ' 恢复事件触发状态，保障后续操作正常执行
        Application.EnableEvents = True
    End If
End Sub

关键改进说明 #

• 新增Worksheet_Activate事件：工作表激活时自动初始化J2和L4的公式，无需用户手动设置。
• 限制事件触发范围：仅当J4单元格被修改时才执行逻辑，避免无关操作触发事件。
• 修正核心逻辑判断：当L4≥4时执行提示、清空、定位操作，完全符合需求。
• 恢复事件触发状态：操作完成后重置Application.EnableEvents = True，避免影响后续工作表事件。
• 强制计算L4值：确保J4修改后立即得到最新的工作日差，避免计算延迟。

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