Excel VBA Worksheet_Change事件触发运行时错误1004问题求助

报错根因 #

错误出现在赋值行的参数非法，触发场景如下：

• 保存新联系人时，存储目标行号的B2单元格为空、值为0或超出Excel工作表最大行限制
• 存储目标列号的Cells(Target.Row, Target.Column + 21)单元格值为空、为非数字或超出最大列限制
• 原代码未关闭事件响应，赋值时递归触发Worksheet_Change事件，导致参数混乱

修复后完整代码 #

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    ' 批量选中时直接退出，避免异常
    If Target.Count > 1 Then Exit Sub
    
    ' 关闭事件响应，防止赋值触发递归
    Application.EnableEvents = False
    ' 异常捕获，避免弹窗中断操作
    On Error GoTo ErrHandle

    ' 点击联系人列表加载表单逻辑
    If Not Intersect(Target, Range("C56:J99999")) Is Nothing And Range("C" & Target.Row).Value <> Empty Then
        Range("B2").Value = Target.Row
        Cont_Load
        GoTo Finish
    End If

    ' 表单字段同步到表格逻辑
    If Not Intersect(Target, Range("D4:D42")) Is Nothing And Range("B4").Value = False And Range("B3").Value = False Then
        Dim tarRow As Long, tarCol As Long
        ' 校验行号合法性
        If IsNumeric(Range("B2").Value) Then
            tarRow = CLng(Range("B2").Value)
            If tarRow < 1 Or tarRow > Rows.Count Then GoTo Finish
        Else
            GoTo Finish
        End If
        ' 校验列号合法性
        If IsNumeric(Cells(Target.Row, Target.Column + 21).Value) Then
            tarCol = CLng(Cells(Target.Row, Target.Column + 21).Value)
            If tarCol < 1 Or tarCol > Columns.Count Then GoTo Finish
        Else
            GoTo Finish
        End If
        ' 合法后执行赋值
        Cells(tarRow, tarCol).Value = Target.Value
    End If

Finish:
    ' 恢复事件响应，必须执行否则表格所有事件都会失效
    Application.EnableEvents = True
    Exit Sub
ErrHandle:
    ' 调试时可取消下一行注释查看错误详情
    ' MsgBox "错误：" & Err.Number & " " & Err.Description
    Resume Finish
End Sub

注意事项 #

替换代码后保存即可，原有功能逻辑完全保留，仅新增了校验和防递归机制，不会影响你之前的表单操作逻辑。如果替换后仍有问题，可以检查Target.Column + 21对应的单元格存储的列号是否正确。

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