Question

我无法弄清楚为什么我的代码出错了。我使用较小的数据集运行它，没有问题，但是当我将其扩展到14k行时，它在第51行完全关闭，首先说“ Excel内存不足”，然后“插入范围类失败的方法”。我期望将其交给可能会看一下代码的人，因此它受到了很大的评论。

该代码应该获取原始数据，并将其转换为可上传到较早系统的格式。为此，它需要在每个唯一帐户上方添加一行，并将该行标记为抬头行（带有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

Answer 1

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的内存不足？

1 个答案: