Excel VBA跨工作簿更新单元格代码错误排查请求

原代码存在的核心问题： #

• 语法错误：缺少End If
  原代码的If条件块没有对应的End If，直接编译报错，必须补上。

• 变量声明不规范
  多数变量未指定数据类型（如cellval、cellval_row等默认是Variant），且存在未使用的变量（adocn、sConnString、aa、ptfile），既浪费资源也容易引发类型错误。

• 未禁用事件触发
  在Worksheet_Change事件中修改单元格内容时，未禁用Application.EnableEvents，会导致事件循环触发，引发重复执行甚至崩溃。

• Find方法无容错处理
  若Find未找到目标内容，会返回Nothing，直接使用cellval_row赋值单元格会抛出“对象变量或With块变量未设置”的错误。

• 路径与文件存在性未校验
  ActiveWorkbook.Path在文件未保存时为空，直接拼接路径会导致打开文件失败；同时未检查目标文件是否存在，容易触发文件未找到错误。

• 单元格引用未指定工作表
  原代码中Cells(1, Target.Column)等引用未明确指定所属工作表，若当前激活工作表不是目标表，会导致逻辑错误。

修正后的完整代码： #

Private Sub Worksheet_Change(ByVal Target As Range)
    ' 指定变量类型，移除未使用变量
    Dim cellval As Variant
    Dim cellval_row As Range
    Dim col_row_number As Long, target_col_number As Long
    Dim targetCol As String
    Dim wb2 As Workbook
    Dim targetSheet As Worksheet
    Dim filePath As String
    
    ' 仅处理单个单元格修改，避免批量操作触发
    If Target.Cells.Count > 1 Then Exit Sub
    
    ' 明确指定当前工作表（绑定事件的工作表）
    With Me
        ' 条件判断：排除指定列，且行号大于1，第一列值有效
        If Not InStr(1, .Cells(1, Target.Column), "DATE", vbTextCompare) > 0 _
            And .Cells(1, Target.Column) <> "SYS Payment Rcvd" _
            And .Cells(Target.Row, 1) > 0 _
            And Target.Row > 1 _
            And .Cells(1, Target.Column) <> "ROW NUMBER" Then
            
            cellval = .Cells(Target.Row, Target.Column).Value
            targetCol = .Cells(1, Target.Column).Value
            
            ' 禁用屏幕刷新与事件触发
            Application.ScreenUpdating = False
            Application.EnableEvents = False
            
            ' 拼接目标文件路径，校验路径有效性
            If ThisWorkbook.Path = "" Then
                MsgBox "当前文件未保存，无法定位目标工作簿！", vbExclamation
                GoTo Cleanup
            End If
            filePath = ThisWorkbook.Path & "\Posted Payments\ptdata.xlsx"
            
            ' 检查文件是否存在
            If Dir(filePath) = "" Then
                MsgBox "目标文件不存在：" & filePath, vbCritical
                GoTo Cleanup
            End If
            
            ' 打开目标工作簿
            Set wb2 = Workbooks.Open(filePath)
            Set targetSheet = wb2.Sheets("frmt")
            
            ' 查找列号，添加容错
            col_row_number = targetSheet.Rows(1).Find(What:="ROW NUMBER", LookIn:=xlValues, LookAt:=xlWhole).Column
            If col_row_number = 0 Then
                MsgBox "目标表未找到ROW NUMBER列！", vbCritical
                GoTo Cleanup
            End If
            
            target_col_number = targetSheet.Rows(1).Find(What:=targetCol, LookIn:=xlValues, LookAt:=xlWhole).Column
            If target_col_number = 0 Then
                MsgBox "目标表未找到" & targetCol & "列！", vbCritical
                GoTo Cleanup
            End If
            
            ' 查找目标行，添加容错
            Set cellval_row = targetSheet.Columns(col_row_number).Find(What:=cellval, LookIn:=xlValues, LookAt:=xlWhole)
            If Not cellval_row Is Nothing Then
                targetSheet.Cells(cellval_row.Row, target_col_number) = cellval
                MsgBox "记录更新完成！", vbInformation
            Else
                MsgBox "未找到匹配的ROW NUMBER值：" & cellval, vbExclamation
            End If
            
            ' 关闭目标工作簿并保存
            wb2.Close SaveChanges:=True
        End If
    End With

Cleanup:
    ' 恢复屏幕刷新与事件触发
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Sub

额外说明： #

1. 若pop_up是你自定义的弹窗过程，可将代码中的MsgBox替换为pop_up调用，但需确保该过程已正确定义。
2. 代码中Me代表当前绑定事件的工作表，若需要指定其他工作表，可替换为ThisWorkbook.Sheets("你的工作表名")。
3. 新增了批量修改判断（Target.Cells.Count > 1 Then Exit Sub），避免批量编辑时触发不必要的操作。

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