Excel VBA实现InputBox非空校验与取消回退功能咨询

针对需要的两类校验逻辑，直接替换原有宏代码即可，已兼容原有的工作表复制、内容粘贴流程，同时优化了录制宏生成的冗余选中操作，运行更稳定：

实现的校验规则 #

• 空输入校验：用户输入内容为空（包含只输入空格的情况）时，弹出错误提示后重新唤起输入框，循环校验直到拿到有效非空内容
• 取消回退逻辑：用户点击InputBox的取消按钮时，自动删除流程中已经新建的临时工作表，直接退出流程回到初始状态，不会残留无效表

完整可用代码 #

Sub SAVE_TEMP_MAR()
'
' SAVE_TEMP_MAR Macro
'
    Dim tempSht As Worksheet
    Dim inputName As String
    
    ' 关闭屏幕更新，避免运行时界面跳闪
    Application.ScreenUpdating = False
    
    ' 复制模板工作表
    Sheets("JP PRN.").Copy Before:=Sheets(4)
    Set tempSht = ActiveSheet
    tempSht.Name = "TEMPORARY MAR"
    
    ' 清空临时表区域、复制空白MAR模板内容
    tempSht.Range("A1:AF18").ClearContents
    Sheets("Blank MAR").Range("A1:AF18").Copy tempSht.Range("A1")
    
    ' 输入校验循环
InputLoop:
    inputName = InputBox("请输入MAR的新名称" & vbNewLine & vbNewLine & "命名规则：住户姓名首字母+药物名称")
    ' 判断是否点击取消按钮：StrPtr返回0为取消操作
    If StrPtr(inputName) = 0 Then
        ' 关闭提示删除新建的临时表
        Application.DisplayAlerts = False
        tempSht.Delete
        Application.DisplayAlerts = True
        ' 恢复屏幕更新后退出过程
        Application.ScreenUpdating = True
        MsgBox "操作已取消，新建临时工作表已删除", vbInformation
        Exit Sub
    End If
    ' 判断是否输入为空
    If Trim(inputName) = "" Then
        MsgBox "输入内容不能为空，请重新输入", vbExclamation
        GoTo InputLoop
    End If
    ' 可选：判断是否存在同名工作表，避免重命名报错
    Dim existSht As Worksheet
    On Error Resume Next
    Set existSht = Sheets(inputName)
    On Error GoTo 0
    If Not existSht Is Nothing Then
        MsgBox "当前工作簿已存在同名工作表，请更换名称", vbExclamation
        Set existSht = Nothing
        GoTo InputLoop
    End If
    
    ' 所有校验通过后重命名工作表
    tempSht.Name = inputName
    tempSht.Range("AG1").Select
    
    ' 恢复屏幕更新
    Application.ScreenUpdating = True
End Sub

关键逻辑说明 #

• 用StrPtr()函数区分两种空返回场景：普通VBA InputBox点击取消时返回值的内存指针为0，输入空内容点确定时指针不为0，解决了常规空值判断无法区分两类操作的问题
• 提前将新建的临时工作表赋值给对象变量tempSht，触发取消逻辑时可精准删除该表，不会误删其他工作表
• 删除工作表前临时关闭系统提示，避免弹出删除确认框打断流程
• 额外增加了重名校验逻辑，可根据实际需求决定是否保留

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