Excel VBA宏首次运行正常二次运行无响应问题排查求助

原代码问题分析 #

导致二次运行无响应的核心原因：

• 未利用Excel表格（ListObject）的原生API，直接操作工作表行，导致表格结构与行数据脱节
• 正向For Each遍历源表格行，操作行时会修改遍历集合，引发遍历异常
• 定义了目标表格对象但未实际使用，直接插入工作表行，未将数据纳入表格范围
• 未处理空行或异常值，二次运行时遍历范围混乱

修正后的代码 #

Sub CutPasteRows()
    Dim sourceTable As ListObject
    Dim targetTable As ListObject
    Dim sourceRow As ListRow
    Dim targetRow As ListRow
    Dim closedDateCol As ListColumn
    Dim i As Long
    
    ' 绑定源表格与目标表格对象
    Set sourceTable = Worksheets("Open").ListObjects("Current_Ops_TBL8")
    Set targetTable = Worksheets("Hold or Closed").ListObjects("Hold_Closed_TBL3")
    Set closedDateCol = sourceTable.ListColumns("IAA CLOSED DATE")
    
    ' 从后往前遍历，避免操作行时打乱遍历顺序
    For i = sourceTable.ListRows.Count To 1 Step -1
        Set sourceRow = sourceTable.ListRows(i)
        
        ' 判断关闭日期列是否存在有效值（排除空值与错误值）
        If Not IsEmpty(sourceRow.Range(closedDateCol.Index).Value) And _
           Not IsError(sourceRow.Range(closedDateCol.Index).Value) Then
           
            ' 在目标表格末尾添加新行并复制数据（保留格式）
            Set targetRow = targetTable.ListRows.Add(AlwaysInsert:=True)
            sourceRow.Range.Copy
            targetRow.Range.PasteSpecial Paste:=xlPasteValuesAndNumberFormats
            
            ' 二选一：清空源行内容（保留空行）/ 删除源行（推荐，避免空行干扰）
            ' sourceRow.Range.ClearContents
            sourceRow.Delete
        End If
    Next i
    
    ' 清除剪贴板，消除弹窗提示
    Application.CutCopyMode = False
End Sub

代码说明 #

• 表格对象绑定：直接操作ListObject和ListRow，确保数据始终在表格结构内，避免工作表行与表格脱节
• 反向遍历：从最后一行往前遍历，处理行删除/清空时不会影响未遍历的行，彻底避免遍历异常
• 有效值校验：同时排除空值和错误值，避免判断逻辑触发异常
• 目标行插入：使用ListRows.Add将数据添加到目标表格，自动扩展表格范围，保持表格结构完整
• 剪贴板清理：移除剪贴板内容，避免Excel弹出多余提示

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