如何修复运行-time 错误“7”内存不足，即使在保存、关闭、重新启动计算机后仍然存在

Question

我的 Excel VBA 宏生成 "Run-time error '7': Out of memory"

Excel 文档在一个 sheet 中包含 5,500 个 csv 文档的列表。宏遍历此列表，并针对每个：a) 将其信息放入合并输出 sheet； b) 增加了一些公式； c) 继续下一个文件。

完成其中大约 3,000 个后，脚本遇到内存不足错误。

主要问题是在保存文件、完全关闭Excel、重新打开Excel、甚至重新启动计算机后，这个问题仍然存在。我还使用了 Paste-Special 来删除所有公式并替换为值。我也切换到手动计算。

我想找到一种方法来防止这个错误发生。至少，如果发生这种情况，我希望能够保存、关闭并重新打开文件，并一次继续浏览列表 3,000 个条目。

我已经通读了之前关于内存不足错误的所有问题和答案，但none似乎在关闭并重新打开后问题仍然存在。

我在下面发布了我的代码的相关部分。调试器显示错误发生在以下行：.Refresh BackgroundQuery:=False。我是运行 Windows 10，Excel 2007。感谢任何帮助。谢谢！

Sub test()

Dim filename As String
Dim outputsheet As String
Dim output_lastrow As Integer

Application.EnableEvents = False

For rep = 2 To 5502
    filename = Sheets("Import Files").Range("A" & rep).Value ‘this takes the form of C:\Users\...\filename1.csv
    outputsheet = "Summary"
    output_lastrow = Sheets(outputsheet).Range("D999999").End(xlUp).Row

    With ActiveSheet.QueryTables.Add(Connection:="TEXT;" + filename, Destination:=Sheets(outputsheet).Range("$A" & output_lastrow + 2))
            .FieldNames = True
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .TextFilePromptOnRefresh = False
            .TextFilePlatform = 437
            .TextFileStartRow = 1
            .TextFileParseType = xlDelimited
            .TextFileTextQualifier = xlTextQualifierDoubleQuote
            .TextFileConsecutiveDelimiter = False
            .TextFileTabDelimiter = False
            .TextFileSemicolonDelimiter = False
            .TextFileCommaDelimiter = True
            .TextFileSpaceDelimiter = False
            .TextFileTrailingMinusNumbers = True
            .Refresh BackgroundQuery:=False
    End With

        output_lastrow = Sheets(outputsheet).Range("D999999").End(xlUp).Row + 1
        Sheets(outputsheet).Range("A" & output_lastrow).Value = "Change"
        Sheets(outputsheet).Range("B" & output_lastrow).Formula = "=R[-1]C"
        Sheets(outputsheet).Range("C" & output_lastrow).Formula = "=R[-1]C"
        Sheets(outputsheet).Range("C" & output_lastrow).AutoFill Destination:=Range("C" & output_lastrow & ":FP" & output_lastrow), Type:=xlFillDefault

    End If

    Dim wbconnection As WorkbookConnection
    For Each wbconnection In ActiveWorkbook.Connections
        If InStr(filename, wbconnection.Name) > 0 Then
            wbconnection.Delete
        End If
    Next wbconnection

Next rep

Answer 1

因为您可以在只读模式下使用 Workbooks.Open 打开 CSV 文件，然后像从普通工作表中一样复制数据，试试这个：

Sub Test()
    Dim filename As String
    Dim outputsheet As String
    Dim output_lastrow As Integer
    Dim wbCSV AS Workbook

    outputsheet = "Summary"

    Application.EnableEvents = False

    For rep = 2 To 5502
        filename = Sheets("Import Files").Cells(rep, 1).Value ‘this takes the form of C:\Users\...\filename1.csv
        output_lastrow = Sheets(outputsheet).Cells(Sheets(outputsheet).Rows.Count, 4).End(xlUp).Row

        'Open CSV File
        Set wbCSV = Workbooks.Open(Filename:=filename, ReadOnly:=True)

        'Copy data to outputsheet
        wbCSV.Worksheets(1).UsedRange.Copy Destination:=ThisWorkbook.Sheets(outputsheet).Cells(output_lastrow + 1, 1)

        'Close CSV File
        wbCSV.Close False
        Set wbCSV = Nothing
    Next rep

    Application.EnableEvents = True
End Sub

如果您将 rep 存储在工作簿中的某处，并且每隔一段时间保存一次 (ThisWorkbook.Save)，那么即使它确实崩溃了，您也可以从上次保存的点恢复循环

如何修复运行-time 错误“7”内存不足，即使在保存、关闭、重新启动计算机后仍然存在

How to fix Run-time error '7' out of memory, which persists even after saving, closing, restarting computer

memory

excel

vba

out

out-of-memory

如何修复 运行-time 错误“7”内存不足，即使在保存、关闭、重新启动计算机后仍然存在

How to fix Run-time error '7' out of memory, which persists even after saving, closing, restarting computer

memory

excel

vba

out

out-of-memory

如何修复运行-time 错误“7”内存不足，即使在保存、关闭、重新启动计算机后仍然存在