实现VBA保存前校验：首次触发条件时仅弹出一次提示框

你的问题根源是循环遍历A10:A160的每个单元格，每遇到一个非空单元格就触发一次校验逻辑，导致提示框重复弹出。正确的逻辑应该是：先判断A列是否存在非空单元格，若存在则一次性检查B5/B6/B7的必填状态，每个必填项仅提示一次。

修改后的代码 #

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Dim r1 As Range, r2 As Range, r3 As Range, r4 As Range
    Dim hasNonEmptyA As Boolean
    
    ' 定义需要校验的范围
    Set r1 = Worksheets("Sheet1").Range("A10:A160")
    Set r2 = Worksheets("Sheet1").Range("B5")
    Set r3 = Worksheets("Sheet1").Range("B6")
    Set r4 = Worksheets("Sheet1").Range("B7")
    
    ' 先判断A列是否存在非空单元格，无需循环每个单元格
    hasNonEmptyA = (WorksheetFunction.CountA(r1) > 0)
    
    ' 只有当A列有非空时，才校验必填项
    If hasNonEmptyA Then
        ' 检查B5
        If IsEmpty(r2) Then
            Application.Goto r2
            Cancel = True
            MsgBox "Number is Required in order to Save. Save Cancelled!"
        End If
        
        ' 检查B6
        If IsEmpty(r3) Then
            Application.Goto r3
            Cancel = True
            MsgBox "Name is Required in order to Save. Save Cancelled!"
        End If
        
        ' 检查B7
        If IsEmpty(r4) Then
            Application.Goto r4
            Cancel = True
            MsgBox "Division is Required in order to Save. Save Cancelled!"
        End If
    End If
End Sub

关键改动说明 #

1. 替换循环判断A列非空：用WorksheetFunction.CountA(r1) > 0直接统计A列非空单元格数量，比循环每个单元格更高效，且只需判断一次。
2. 单次校验必填项：仅当A列存在非空时，依次检查B5/B6/B7，每个必填项的校验逻辑只执行一次，避免重复弹窗。
3. 保留定位与阻止保存：每个空的必填项会自动定位到对应单元格，且只要有一个必填项为空，就会设置Cancel = True阻止保存。

额外优化建议 #

如果希望多个必填项为空时，只弹出一个汇总提示（而非逐个弹窗），可以修改为收集所有缺失项后一次性提示：

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Dim r1 As Range, r2 As Range, r3 As Range, r4 As Range
    Dim hasNonEmptyA As Boolean
    Dim missingFields As String
    
    Set r1 = Worksheets("Sheet1").Range("A10:A160")
    Set r2 = Worksheets("Sheet1").Range("B5")
    Set r3 = Worksheets("Sheet1").Range("B6")
    Set r4 = Worksheets("Sheet1").Range("B7")
    
    hasNonEmptyA = (WorksheetFunction.CountA(r1) > 0)
    
    If hasNonEmptyA Then
        ' 收集缺失的必填项
        If IsEmpty(r2) Then missingFields = missingFields & "- Number (B5)" & vbCrLf
        If IsEmpty(r3) Then missingFields = missingFields & "- Name (B6)" & vbCrLf
        If IsEmpty(r4) Then missingFields = missingFields & "- Division (B7)" & vbCrLf
        
        ' 如果有缺失项，提示并阻止保存
        If missingFields <> "" Then
            Cancel = True
            MsgBox "以下必填项未填写，无法保存：" & vbCrLf & missingFields, vbExclamation
            ' 定位到第一个缺失的单元格
            If IsEmpty(r2) Then
                Application.Goto r2
            ElseIf IsEmpty(r3) Then
                Application.Goto r3
            Else
                Application.Goto r4
            End If
        End If
    End If
End Sub

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