如何用VBA实现Excel动态单元格验证？脚本报错及触发优化求助

修复后的完整代码 #

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Date1Cell As Range
    Dim Date2Cell As Range
    Dim Date1ValueCell As Range
    Dim Date2ValueCell As Range
    Dim MonitorRange As Range
    
    ' 定位Date1和Date2所在单元格，精确匹配文本
    Set Date1Cell = Sheets("Data").Range("B1:B150").Find(What:="Date1", LookIn:=xlValues, LookAt:=xlWhole)
    Set Date2Cell = Sheets("Data").Range("B1:B150").Find(What:="Date2", LookIn:=xlValues, LookAt:=xlWhole)
    
    ' 检查是否找到目标单元格，避免空对象触发错误
    If Date1Cell Is Nothing Or Date2Cell Is Nothing Then
        Exit Sub
    End If
    
    ' 获取日期值所在的右侧单元格
    Set Date1ValueCell = Date1Cell.Offset(0, 1)
    Set Date2ValueCell = Date2Cell.Offset(0, 1)
    
    ' 定义需要监控的单元格范围：Date1/Date2文本单元格 + 右侧日期单元格
    Set MonitorRange = Union(Date1Cell, Date2Cell, Date1ValueCell, Date2ValueCell)
    
    ' 仅当修改的单元格在监控范围内时执行验证
    If Not Intersect(Target, MonitorRange) Is Nothing Then
        ' 先验证单元格内容为有效日期
        If IsDate(Date1ValueCell.Value) And IsDate(Date2ValueCell.Value) Then
            If Date1ValueCell.Value < Date2ValueCell.Value Then
                MsgBox "Date1不能早于Date2。", vbExclamation, "验证错误"
            End If
        Else
            MsgBox "请输入有效的日期格式。", vbExclamation, "格式错误"
        End If
    End If
End Sub

关键问题修复说明 #

• 解决"应用程序定义或对象定义错误"

  1. 修正区域引用错误：原代码Columns("B1:B150")写法违规，Columns仅支持列标（如"B"）或列号（如2），改为Range("B1:B150")指定具体区域。
  2. 增加空对象判断：Find方法可能找不到目标文本，导致Date1Cell或Date2Cell为Nothing，直接访问Offset会触发错误，修复后未找到目标则直接退出脚本。
  3. 补充日期格式校验：避免非日期值导致的对比逻辑错误，增加IsDate检查确保单元格内容为有效日期。

• 限制脚本触发条件

  1. 定义监控范围：将Date1/Date2的文本单元格及其右侧的日期单元格合并为监控范围。
  2. 用Intersect判断修改范围：只有当修改的单元格属于监控范围时，才执行验证逻辑，避免任意单元格变更都触发脚本。

额外优化点 #

• 加入LookAt:=xlWhole确保Find精确匹配单元格完整文本，避免误匹配包含"Date1"的其他内容（如"Date123"）。
• 变量命名更清晰，区分单元格对象与日期值，提升代码可读性。

内容的提问来源于stack exchange，提问作者M Waqar Anwar