如何修复Excel宏中的Runtime Error 7（内存不足）错误？

问题描述 #

运行合并3个Excel文件的宏时出现Runtime Error 7（内存不足），卡在第132行：.Cells(i, 4) = .Cells(i, 4) & .Cells(i + 1, 4)。已设置虚拟内存为推荐值，仅运行该宏，怀疑循环导致问题，希望小幅修改代码解决，避免跳过该行导致数据不完整。

原报错代码片段：

Dim i As Long
Dim lastRow As Long

    With SnapDataTool.Sheets("Transcripts")
        .Activate
        lastRow = .Cells(rows.Count, 1).End(xlUp).Row
        .Columns("A:E").Sort key1:=Range("A1"), order1:=xlAscending, Header:=xlYes
        
        For i = 2 To lastRow
                
                DoEvents
                SimpleStatus.updateTB.Caption = "Cleaning up the chat and email transcripts..." & vbCrLf & "Current Line: " & i
                DoEvents
                
                Do While .Cells(i, 1) = .Cells(i + 1, 1)
                    If .Cells(i, 1) = "" Then
                        Exit Do
                    End If
                        
                    .Cells(i, 4) = .Cells(i, 4) & .Cells(i + 1, 4)
                    .rows(i + 1).EntireRow.Delete
                    lastRow = lastRow - 1
                    
                Loop
        Next i
        
        ' 后续代码省略
    End With

End Sub

问题原因 #

原代码有两个核心问题导致内存耗尽：

• 逐行操作单元格并删除行，每次操作都会触发Excel界面刷新和内存重新分配，数据量大时会快速占用内存
• 反复直接拼接单元格文本，每次拼接都会生成新的字符串对象，累积后占用大量内存

修改方案 #

通过数组批量处理数据+关闭不必要的Excel后台功能降低内存占用，修改后的代码如下：

Dim i As Long, j As Long
Dim lastRow As Long
Dim dataArr As Variant
Dim concatText As String
Dim keepRows As Collection

' 临时关闭Excel冗余功能，减少内存消耗和卡顿
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

With SnapDataTool.Sheets("Transcripts")
    lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
    .Columns("A:E").Sort Key1:=.Range("A1"), Order1:=xlAscending, Header:=xlYes
    
    ' 一次性将数据读入内存数组，比直接操作单元格效率高、内存占用少
    dataArr = .Range("A1:E" & lastRow).Value
    
    Set keepRows = New Collection
    keepRows.Add 1 ' 保留表头行
    
    i = 2
    Do While i <= lastRow
        ' 更新状态提示
        SimpleStatus.updateTB.Caption = "Cleaning up the chat and email transcripts..." & vbCrLf & "Current Line: " & i
        DoEvents
        
        concatText = dataArr(i, 4)
        ' 合并同A列值的第4列内容
        Do While i < lastRow And dataArr(i, 1) = dataArr(i + 1, 1) And dataArr(i, 1) <> ""
            concatText = concatText & dataArr(i + 1, 4)
            i = i + 1
        Loop
        dataArr(i, 4) = concatText
        keepRows.Add i ' 记录需要保留的行号
        i = i + 1
    Loop
    
    ' 清空原数据区域
    .Range("A2:E" & lastRow).ClearContents
    
    ' 将处理后的有效数据整理并写回工作表
    Dim outputArr As Variant
    ReDim outputArr(1 To keepRows.Count, 1 To 5)
    For i = 1 To keepRows.Count
        For j = 1 To 5
            outputArr(i, j) = dataArr(keepRows(i), j)
        Next j
    Next i
    .Range("A1").Resize(UBound(outputArr, 1), 5).Value = outputArr
    
    ' 执行原有后续操作
    .Columns(2).EntireColumn.Delete
    .Columns(4).EntireColumn.Delete
    .Columns(3).WrapText = False
    
    SimpleStatus.updateTB.Caption = "Concatenation complete..."
    SimpleStatus.Show vbModeless
    DoEvents
End With

' 恢复Excel默认设置
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic

修改要点说明 #

1. 关闭后台功能：临时关闭屏幕更新、事件触发和自动计算，大幅减少内存消耗和运行卡顿
2. 数组批量处理：一次性读取所有数据到内存数组中操作，避免反复读写单元格的内存开销
3. 批量记录有效行：先完成文本合并，再记录需要保留的行，最后一次性写回数据，避免逐行删除的内存浪费
4. 优化字符串拼接：用临时变量存储拼接结果，减少中间字符串对象的生成

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