VB代码运行时错误排查：工作表间表格数据复制问题

错误原因分析 #

1. 第32行核心错误：
   你用engagementRow.ListObjects("Engagement")是完全错误的——engagementRow是单个表格行对象，根本没有ListObjects属性。正确的做法是直接通过该行的Range结合Client列的索引来取值。

2. 复制数据时的逻辑错误：
   你写的financeRow.ListObject.ListColumns("Project").DataBodyRange.Value会把Finance表格的整个Project列都设成同一个值，而不是只给新增的那一行赋值。应该针对新增行的对应列单元格赋值。

3. 额外隐患：
   修改Finance表格时会再次触发Worksheet_Change事件，导致无限循环，需要临时关闭事件触发。

修正后的完整代码 #

Private Sub Worksheet_Change(ByVal Target As Range)
    ' 禁止事件递归触发
    Application.EnableEvents = False
    
    ' 定义工作表和表格对象
    Dim wsEngagements As Worksheet
    Dim wsPnL As Worksheet
    Dim tblEngagement As ListObject
    Dim tblFinance As ListObject
    
    ' 绑定工作表
    Set wsEngagements = ThisWorkbook.Sheets("Engagements")
    Set wsPnL = ThisWorkbook.Sheets("P&L")
    
    ' 绑定表格
    Set tblEngagement = wsEngagements.ListObjects("Engagement")
    Set tblFinance = wsPnL.ListObjects("Finance")
    
    ' 仅处理单个单元格修改，且修改在Engagement表格的Project列
    If Target.Cells.Count = 1 And Not Intersect(Target, tblEngagement.ListColumns("Project").DataBodyRange) Is Nothing Then
        Dim projectName As String
        projectName = Target.Value
        
        ' 跳过空值
        If projectName = "" Then GoTo Cleanup
        
        Dim clientName As String
        Dim clientColIndex As Integer
        clientColIndex = tblEngagement.ListColumns("Client").Index
        
        ' 获取当前修改行对应的Client值
        clientName = tblEngagement.DataBodyRange(Target.Row - tblEngagement.HeaderRowRange.Row, clientColIndex).Value
        
        ' 检查Project是否已存在于Finance表格
        If WorksheetFunction.CountIf(tblFinance.ListColumns("Project").DataBodyRange, projectName) = 0 Then
            Dim newFinanceRow As ListRow
            Set newFinanceRow = tblFinance.ListRows.Add
            
            ' 给新增行的对应列赋值
            newFinanceRow.Range(tblFinance.ListColumns("Project").Index).Value = projectName
            newFinanceRow.Range(tblFinance.ListColumns("Client").Index).Value = clientName
            
            MsgBox "项目'" & projectName & "'及客户'" & clientName & "'已成功复制到Finance表格。"
        Else
            MsgBox "项目'" & projectName & "'已存在于Finance表格中。"
        End If
    End If

Cleanup:
    ' 恢复事件触发
    Application.EnableEvents = True
End Sub

关键修改点说明 #

• 移除了错误的engagementRow.ListObjects调用，改用表格的DataBodyRange结合行号和列索引获取Client值
• 给新增的Finance表格行赋值时，直接操作该行Range的对应列，避免修改整列
• 添加了Application.EnableEvents = False/True，防止修改表格时触发循环事件
• 增加了单个单元格修改的判断，避免批量修改时出错

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