Excel VBA如何基于多列值实现列数据联动校验

以下代码基于工作表Change事件实现实时校验，修改单元格内容后会自动触发规则校验，你可以根据自己的实际列对应关系修改代码中的列号参数。

使用方法 #

• 按Alt + F11打开VBA编辑器
• 在左侧工程面板双击需要添加校验规则的工作表
• 将代码粘贴到右侧编辑区域，保存文件为xlsm格式即可生效

完整代码 #

Private Sub Worksheet_Change(ByVal Target As Range)
    ' 定义列号，可根据实际表结构调整
    Const COL_DATE1 As Integer = 1 ' Date1列，示例为A列
    Const COL_DATE2 As Integer = 2 ' Date2列，示例为B列
    Const COL_VALUE As Integer = 3 ' Value列，示例为C列
    Const COL_TIME1 As Integer = 4 ' Time1列，示例为D列
    Const COL_TIME2 As Integer = 5 ' Time2列，示例为E列
    
    Dim rng As Range
    Dim rowNum As Long
    
    ' 关闭事件避免循环触发
    Application.EnableEvents = False
    On Error GoTo ErrHandler
    
    ' 遍历所有修改的单元格
    For Each rng In Target
        rowNum = rng.Row
        ' 跳过表头行，假设表头在第1行，数据从第2行开始
        If rowNum < 2 Then GoTo NextRng
        
        ' --------------------------
        ' 规则1：Date2列校验
        ' --------------------------
        If rng.Column = COL_DATE2 Or rng.Column = COL_DATE1 Then
            If Cells(rowNum, COL_DATE1).Value <> "" And IsDate(Cells(rowNum, COL_DATE1).Value) Then
                If Cells(rowNum, COL_DATE2).Value <> "" And IsDate(Cells(rowNum, COL_DATE2).Value) Then
                    If Cells(rowNum, COL_DATE2).Value <= Cells(rowNum, COL_DATE1).Value Then
                        Cells(rowNum, COL_DATE2).ClearContents
                        MsgBox "第" & rowNum & "行Date2必须大于Date1，请重新输入", vbExclamation
                    End If
                End If
            End If
        End If
        
        ' --------------------------
        ' 规则2：Value列校验
        ' --------------------------
        If rng.Column = COL_VALUE Or rng.Column = COL_TIME1 Or rng.Column = COL_TIME2 Then
            If Cells(rowNum, COL_VALUE).Value <> "" Then
                If Cells(rowNum, COL_TIME1).Value <> "" Or Cells(rowNum, COL_TIME2).Value <> "" Then
                    Cells(rowNum, COL_TIME1).ClearContents
                    Cells(rowNum, COL_TIME2).ClearContents
                    MsgBox "第" & rowNum & "行Value有值时Time1、Time2必须为空", vbExclamation
                End If
            End If
        End If
        
        ' --------------------------
        ' 规则3：Time1列校验
        ' --------------------------
        If rng.Column = COL_TIME1 Or rng.Column = COL_VALUE Then
            If Cells(rowNum, COL_TIME1).Value <> "" Then
                If Cells(rowNum, COL_VALUE).Value <> "" Then
                    Cells(rowNum, COL_TIME1).ClearContents
                    MsgBox "第" & rowNum & "行Time1有值时Value必须为空", vbExclamation
                End If
            End If
        End If
        
        ' --------------------------
        ' 规则4：Time2列校验
        ' --------------------------
        If rng.Column = COL_TIME2 Or rng.Column = COL_TIME1 Or rng.Column = COL_VALUE Then
            If Cells(rowNum, COL_TIME2).Value <> "" Then
                ' 先校验Value为空
                If Cells(rowNum, COL_VALUE).Value <> "" Then
                    Cells(rowNum, COL_TIME2).ClearContents
                    MsgBox "第" & rowNum & "行Time2有值时Value必须为空", vbExclamation
                ' 再校验Time1不为空
                ElseIf Cells(rowNum, COL_TIME1).Value = "" Or Not IsDate(Cells(rowNum, COL_TIME1).Value) Then
                    Cells(rowNum, COL_TIME2).ClearContents
                    MsgBox "第" & rowNum & "行Time2有值时Time1必须先填写有效值", vbExclamation
                ' 最后校验Time2大于Time1
                ElseIf IsDate(Cells(rowNum, COL_TIME2).Value) And Cells(rowNum, COL_TIME2).Value <= Cells(rowNum, COL_TIME1).Value Then
                    Cells(rowNum, COL_TIME2).ClearContents
                    MsgBox "第" & rowNum & "行Time2必须大于Time1，请重新输入", vbExclamation
                End If
            End If
        End If
        
NextRng:
    Next rng
    
ErrHandler:
    ' 恢复事件触发
    Application.EnableEvents = True
    If Err.Number <> 0 Then
        MsgBox "校验出错：" & Err.Description, vbCritical
    End If
End Sub

补充说明 #

如果你需要批量校验历史数据，可以单独编写遍历宏，对所有数据行执行上述校验逻辑即可，无需等待单元格修改触发。

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