为什么Excel内存不足？

我不明白为什么我的代码出错了。我用一个较小的数据集运行它，它没有问题，但当我将它扩展到14k行时，它在第51行上完全关闭，首先说“Excel内存不足”，然后说“Range类的插入方法失败”。我期待着把它交给可能会查看代码的人，这样它就会被大量注释

代码应该获取原始数据，并将其转换为上传到旧系统的格式。为此，需要在每个唯一帐户上方添加一行，并将该行标记为标题行（带有H）。它还添加了一些列

任何关于它为什么会抛出错误的想法都将不胜感激

Option Explicit
Sub ProgramUpload()

'First we define our worksheet variables
Dim wsRaw As Worksheet
Set wsRaw = Worksheets("Raw Data")
Dim wsW As Worksheet
Set wsW = Worksheets("Program Upload")

wsW.UsedRange.ClearContents

'We need a temporary spreadsheet, so let us create and define it
Sheets.Add.Name = "Temporary"
Dim wsTemp As Worksheet
Set wsTemp = Worksheets("Temporary")

Dim lrRaw As Long
lrRaw = wsRaw.Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row

'We want to copy the raw data from Raw to the Program Upload
wsW.Range("A1:C" & lrRaw).Value = wsRaw.Range("A1:C" & lrRaw).Value

'We need to copy column A into our temporary sheet because we want
'to create a unique list of accounts. I chose column Q to make it
'easier to tell what worksheet we are dealing with.

wsTemp.Range("Q1:Q" & lrRaw).Value = wsRaw.Range("A1:A" & lrRaw).Value

'Remove the duplicates
wsTemp.Range("Q1:Q" & lrRaw).RemoveDuplicates Columns:=1, Header:=xlYes

'Locate the last row with data in Q
Dim lrQ As Long
lrQ = wsTemp.Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row

'Now we want to define our current row on Q
Dim rQ As Long
rQ = 2 'Since we left headers in we want to start at Q2

wsW.Columns("A:A").EntireColumn.Insert
wsW.Range("A2:A" & lrRaw).Value = "D"
Dim rFind As Long

For rQ = 2 To lrQ
    rFind = wsW.Range("B1:B" & lrRaw + lrQ).Find(What:=wsTemp.Range("Q" & rQ).Value).Row
    wsW.Rows(rFind).EntireRow.Insert   'Error Happens Here! 
    wsW.Rows(rFind).Value = wsW.Rows(rFind + 1).Value 'Sometimes Errors Here As Well! 
    wsW.Range("A" & rFind).Value = "H"
Next rQ

Application.DisplayAlerts = False
Sheets("Temporary").Delete
Application.DisplayAlerts = True

wsW.Columns("C:F").EntireColumn.Insert

wsW.Range("A1").Value = "Column 1"
wsW.Range("B1").Value = "Column 2"
wsW.Range("C1").Value = "Column 3"
wsW.Range("D1").Value = "Column 4"
wsW.Range("E1").Value = "Column 5"
wsW.Range("F1").Value = "Column 6"
wsW.Range("G1").Value = "Column 7"
wsW.Range("H1").Value = "Column 8"
wsW.Range("I1").Value = "Column 9"

wsW.Range("A:I").Columns.AutoFit

End Sub

---

Excel不喜欢一次又一次地复制大量数据，因为它必须将这些数据保存在内存中—在

For

循环中，插入整行—Excel行可以扩展相当长的时间，因此Excel必须同时将所有这些数据保存在内存中

相反，我建议您只复制所需的列。假设我们有5列；那么，您的

For

循环可能如下所示：

For rQ = 2 To lrQ 
    rFind = wsW.Range("B1:B" & lrRaw + lrQ).Find(What:=wsRaw.Range("Q" & rQ).Value).Row 
    wsW.Rows(rFind).EntireRow.Insert
    ' Notice we're only copying over 5 columns - not the entire row! 
    wsW.Range(Cells(rFind, 1), Cells(rFind, 5)).Value = wsW.Range(Cells(rFind + 1, 1), Cells(rFind + 1, 5)).Value
    wsW.Range("A" & rFind).Value = "H" 
Next rQ

---

您使用的是什么版本的Excel？它是32位还是64位。32位。我们无法使用64位。因此我发现您的代码中可能存在一些问题。看起来您可能正在插入行，因为您的

for

循环遍历行-因此，现在，您的下一行可能就是您插入的行！然而，如果您确信它适用于较小的数据集，那么它不太可能是这样。我会尝试每隔100次保存您的工作簿吗？保存工作簿可以减少Excel需要记住的内容，从而节省内存。您可以使用

工作簿.Save

方法我无法用测试数据重现问题，但我可以看到它是如何在49或51之后剥离所有行的。@ArodPonyboy678添加了一个保存步骤，以便它触发每个步骤，使其在50%的时间内工作，有时达到迭代200，然后失败，但我不明白为什么这本工作簿连内存都有问题。它正在做的事情是1。在14K行中搜索一个值，保存该值的行，插入一行，新行的值=下面行的值。我在更大的数据上运行了Find。此文档只有纯文本形式的数据，没有其他选项卡。没有其他程序正在运行以消耗可用内存。