Excel VBA脚本提交更新工作表时无故崩溃退出问题求助

核心原因定位及修复方案 #

• 全局错误跳过配置导致无报错退出
  若项目其他位置的代码运行过On Error Resume Next且未重置，会导致所有错误静默触发，遇到异常直接跳出当前过程。
  修复方式：在cmdSubmit_Click过程第一行添加On Error GoTo 0，强制关闭错误跳过逻辑，运行即可看到真实报错信息。
• 工作表变更事件冲突
  修改单元格值时会自动触发Worksheet_Change事件，如果该事件代码中包含End语句、未处理的异常，会直接终止所有VBA运行，无任何提示。
  修复方式：打开「Personal」工作表对应的代码模块，临时注释所有Worksheet_Change事件的代码后重新测试提交功能。如果运行正常，后续优化事件代码即可：在事件开头加Application.EnableEvents = False，事件结束前加Application.EnableEvents = True，同时删除所有直接终止程序的End语句。
• 数据类型不匹配触发静默错误
  当前的日期对比逻辑直接将单元格值和窗体文本框值做文本对比，若单元格是日期格式、文本框输入的是文本格式的日期，会出现匹配逻辑异常；同时如果txtweight/txtpush为空、内容非数值，赋值时也会触发隐形错误。
  修复方式：
  1. 日期对比统一转换为日期类型：If CDate(Trim(Worksheets("Personal").Range("A1").Offset(x).Value)) = CDate(txtdate.Value) Then
  2. 赋值前做格式校验：Worksheets("Personal").Range("A1").Offset(x, 1).Value = IIf(IsNumeric(txtweight.Value), CDbl(txtweight.Value), 0)

代码优化建议 #

Do循环逐行查找日期的逻辑效率较低，可替换为VBA内置的Find方法，性能更高也更稳定：

Private Sub cmdSubmit_Click()
    On Error GoTo 0
    Dim findRng As Range
    ' 查找匹配日期的行
    Set findRng = Worksheets("Personal").Range("A:A").Find(What:=CDate(txtdate.Value), LookIn:=xlValues, LookAt:=xlWhole)
    If findRng Is Nothing Then
        MsgBox "Date not found"
        Exit Sub
    End If
    ' 写入数据
    findRng.Offset(0, 1).Value = IIf(IsNumeric(txtweight.Value), CDbl(txtweight.Value), 0)
    findRng.Offset(0, 2).Value = findRng.Offset(0, 2).Value + IIf(IsNumeric(txtpush.Value), CDbl(txtpush.Value), 0)
    findRng.Offset(0, 3).Value = IIf(CBWalk.Value, "x", "")
    
    Unload Me
End Sub

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