如何用VBScript实现Excel按行条件判定的必填单元格缺失校验

校验规则说明 #

• 表格范围为100行20列，首行默认为列标题行
• 若行A列取值为Reportable，需校验指定必填列是否为空
• 若行A列取值为Non-Reportable，需校验另一组指定必填列是否为空
• 保存文件时触发全量校验，仅弹出1次统一提示，列明所有缺失值的行号和对应列标题，校验不通过则阻止保存

原代码问题梳理 #

1. 校验范围仅覆盖前3行的固定列，没有适配100行全量数据的动态校验逻辑
2. 每检测到1个错误就直接弹窗，导致多次弹出提示
3. 没有根据A列的取值动态切换必填校验的列范围
4. 错误信息没有关联对应行号和列标题，排查成本高

可直接运行的VBA代码 #

将以下代码放入Excel的ThisWorkbook模块即可生效，代码中已标注可自定义配置的区域，你可以根据实际业务要求调整必填列的配置：

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    ' ========== 自定义配置区域 开始 ==========
    ' Reportable对应的必填列号（B列是2，C列是3，以此类推）
    Const REPORTABLE_REQUIRED_COLS = "2,4,5"
    ' 上述列号对应的列标题，顺序要和上面的列号一一对应
    Const REPORTABLE_COL_NAMES = "Signoff,tax Regime,Classification"
    ' Non-Reportable对应的必填列号，示例为3、6、7列，可自行修改
    Const NON_REPORTABLE_REQUIRED_COLS = "3,6,7"
    ' 上述列号对应的列标题，顺序要和上面的列号一一对应
    Const NON_REPORTABLE_COL_NAMES = "字段1,字段2,字段3"
    ' 数据行范围：首行是表头，从第2行到第100行
    Const DATA_START_ROW = 2
    Const DATA_END_ROW = 100
    ' ========== 自定义配置区域 结束 ==========
    
    Dim errMsg As String
    Dim rptCols, rptNames, nonRptCols, nonRptNames
    Dim i As Long, j As Integer
    Dim aVal As String
    
    errMsg = ""
    ' 拆分必填列配置为数组
    rptCols = Split(REPORTABLE_REQUIRED_COLS, ",")
    rptNames = Split(REPORTABLE_COL_NAMES, ",")
    nonRptCols = Split(NON_REPORTABLE_REQUIRED_COLS, ",")
    nonRptNames = Split(NON_REPORTABLE_COL_NAMES, ",")
    
    ' 遍历所有数据行
    For i = DATA_START_ROW To DATA_END_ROW
        aVal = Trim(Cells(i, 1).Value)
        If aVal = "Reportable" Then
            ' 校验Reportable对应的必填列
            For j = LBound(rptCols) To UBound(rptCols)
                If Trim(Cells(i, CInt(rptCols(j))).Value) = "" Then
                    errMsg = errMsg & "第" & i & "行：" & rptNames(j) & " 为空" & vbCrLf
                End If
            Next j
        ElseIf aVal = "Non-Reportable" Then
            ' 校验Non-Reportable对应的必填列
            For j = LBound(nonRptCols) To UBound(nonRptCols)
                If Trim(Cells(i, CInt(nonRptCols(j))).Value) = "" Then
                    errMsg = errMsg & "第" & i & "行：" & nonRptNames(j) & " 为空" & vbCrLf
                End If
            Next j
        End If
    Next i
    
    ' 有错误则弹窗提示，阻止保存
    If errMsg <> "" Then
        MsgBox "存在以下必填项为空，请修正后再保存：" & vbCrLf & vbCrLf & errMsg, vbExclamation, "必填项校验不通过"
        Cancel = True
    End If
End Sub

如果需要在关闭文件时也触发校验，只需要把上述代码的事件名改为Workbook_BeforeClose(Cancel As Boolean)即可。

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