VBA宏遍历约4000行后致Excel停止/卡顿问题求助

这种情况我在帮团队排查宏性能问题时遇到过好几次，核心原因基本都是内存过载或者低效的循环逻辑，结合你的场景给你几个针对性的解决方案：

1. 先排查「频繁创建新工作表」的致命问题 #

你提到“每次循环将相关数据移至工作簿新工作表”——如果是每一行/每一条数据就新建一个工作表，那到4000+个工作表时，Excel的内存肯定扛不住，直接触发无响应或静默停止（这是Excel保护自身的机制）。

解决思路：

• 不要每次循环都新建工作表，先按数据分组（比如按类别、ID），同一组的数据放到同一个工作表里
• 如果确实需要每个条目单独工作表，建议批量创建后再写入数据，而不是循环一次创建一次

2. 用数组代替逐行操作Range对象 #

Excel操作单元格对象（比如Range）的效率极低，14000+行逐行读取/写入会持续消耗内存，到阈值就会卡顿。正确的做法是先把所有数据读到内存数组里处理，再一次性写入目标位置，速度能提升几十甚至上百倍。

示例代码片段：

Sub FastDataMove()
    ' 关闭Excel的实时刷新和计算，减少性能消耗
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    Dim sourceWS As Worksheet, lastRow As Long
    Dim sourceData As Variant, targetData As Variant
    Dim i As Long, targetRow As Long
    
    Set sourceWS = ThisWorkbook.Sheets("你的源工作表")
    ' 读取所有源数据到数组
    lastRow = sourceWS.Cells(sourceWS.Rows.Count, "A").End(xlUp).Row
    sourceData = sourceWS.Range("A1:Z" & lastRow).Value ' 按需调整列范围
    
    ' 初始化目标数组（假设只提取符合条件的行）
    ReDim targetData(1 To lastRow, 1 To UBound(sourceData, 2))
    targetRow = 0
    
    ' 在内存数组里循环处理，完全不操作Excel对象
    For i = 1 To lastRow
        ' 替换成你的判断条件，比如If sourceData(i, 1) = "需要移动的条件" Then
        If sourceData(i, 1) <> "" Then ' 示例条件：非空行
            targetRow = targetRow + 1
            ' 复制整行数据到目标数组
            For j = 1 To UBound(sourceData, 2)
                targetData(targetRow, j) = sourceData(i, j)
            Next j
        End If
    Next i
    
    ' 创建单个目标工作表并一次性写入数据
    Dim targetWS As Worksheet
    Set targetWS = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
    targetWS.Name = "整理后数据"
    targetWS.Range("A1").Resize(targetRow, UBound(sourceData, 2)).Value = targetData
    
    ' 恢复Excel的默认设置
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Set sourceWS = Nothing
    Set targetWS = Nothing
End Sub

3. 修正LastRow的计算逻辑（避免误判行数） #

有时候LastRow变量返回的是错误值（比如遇到中间空行、隐藏行），导致循环处理了超出实际数据范围的行，额外消耗内存。建议用更严谨的方式计算：

' 针对特定列计算最后一行（比如A列）
lastRow = sourceWS.Cells(sourceWS.Rows.Count, "A").End(xlUp).Row
' 如果是整个工作表的已用范围，用这个：
lastRow = sourceWS.UsedRange.Rows(sourceWS.UsedRange.Rows.Count).Row

4. 清理内存与优化设置 #

• 循环结束后及时释放对象：Set 对象 = Nothing
• 避免在循环里使用Select/Activate（这些操作会强制刷新屏幕，极度耗性能）
• 如果工作表有大量条件格式、数据验证，建议先删除再处理，完成后再恢复

按这个思路调整后，14000+行的处理应该能顺畅完成，不会再出现中途卡顿的情况。

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