如何修复运行时错误'7‘内存不足，即使在保存，关闭，重新启动计算机后仍然存在
如何修复运行时错误'7‘内存不足，即使在保存，关闭，重新启动计算机后仍然存在
提问于 2018-12-20 10:45:52
我的Excel VBA宏产生“运行时错误'7'：内存不足”
Excel文档在一个工作表中包含5,500个csv文档的列表。Macro遍历此列表，并针对每个列表: a)将其信息放入合并的输出表中；b)添加一些公式；c)转到下一个文件。
在完成了大约3,000个任务后，脚本遇到了内存不足错误。
主要问题是，在保存文件、完全关闭Excel、重新打开Excel甚至重新启动计算机后，此问题仍然存在。我还使用了Paste-Special来删除所有公式，并替换为值。我还切换到了手动计算。
我想找到一种方法来防止这种错误的发生。至少，如果发生这种情况，我希望能够保存、关闭和重新打开文件，并保持一次浏览列表中的3,000个条目。
我已经阅读了之前关于内存不足错误的所有问题和答案，但似乎没有一个问题在关闭和重新打开后仍然存在。
我在下面发布了我的代码的相关部分。调试器显示错误发生在行：.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回答 1
Stack Overflow用户
回答已采纳
发布于 2018-12-20 22:16:56
由于您可以在只读模式下使用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)，那么即使它崩溃，您也可以从您保存的最后一个点恢复循环
页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接：
https://stackoverflow.com/questions/53861779
复制相关文章
相似问题
腾讯云开发者
