我的Excel VBA宏产生“运行时错误'7'：内存不足”
Excel文档在一张纸上列出了5,500个csv文档。宏将遍历此列表，并针对每个宏：a）将其信息放入合并的输出表中；b）添加一些公式；c）转到下一个文件。
完成约3,000个脚本后，脚本遇到了内存不足错误。
主要问题是保存文件，完全关闭Excel，重新打开Excel甚至重新启动计算机后，此问题仍然存在。我还使用“选择性粘贴”来摆脱所有公式并替换为值。我也切换到手动计算。
我想找到一种方法来防止发生此错误。至少，如果发生的话，我希望能够保存，关闭和重新打开文件，并一次又一次地浏览列表3,000个条目。
我已经阅读了所有先前有关内存不足错误的问题和解答，但是似乎没有一个问题在关闭并重新打开后仍然存在。
我将在下面发布代码的相关部分。调试器显示该错误发生在以下行：.Refresh BackgroundQuery：= False。我正在运行Windows 10，Excel2007。不胜感激。谢谢！
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
由于您只能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），那么即使它崩溃了，也可以从保存的最后一点继续循环
本文收集自互联网，转载请注明来源。
如有侵权，请联系 [email protected] 删除。
我来说两句