Excel上的“内存不足”错误的VBA

我在Excel 2010上，在一个公认的非常大的表（400K行X 20列）。

我的代码旨在：

• 将整个工作表加载到一个数组中
• 检查每一行的一定标准
• 有资格的行被复制到另一个数组中
• 最后将第二个数组返回到另一个表单
• 第二arrays将最终大约是原来的90％

我写了两个variables数组的定义，并试图通过复制工作表内容两次来初始化它们。

第一个副本的作品，但第二个我打了一个“内存不足”的错误。

任何想法，如果有一个解决方法？ 或者这只是VBA / Excel的限制。

有没有一种方法来预先定义/初始化目的地数组，而是让它“成长”与标准的每一个成功的资格？ （在这个规模上）。

Sub CopyPending() Dim LastRow As Long Dim LastCol As Integer Dim AllRange() As Variant Dim CopyRange() As Variant Dim i As Long Dim x As Long Dim z As Long LastCol = 21 LastRow = ActiveSheet.UsedRange.Rows.Count AllRange = Range(Cells(2, 1), Cells(LastRow, LastCol)).Value CopyRange = Range(Cells(2, 1), Cells(LastRow, LastCol)).Value ''' ERROR TRIGGER i = 1 x = 1 z = 1 For i = LBound(AllRange) To UBound(AllRange) - 1 If AllRange(i, 7) = "TestCriteria" Then For z = 1 To LastCol CopyRange(x, z) = AllRange(i, z) Next z x = x + 1 End If Next i With Sheets(2) .Range(.Cells(2, 1), .Cells(x, LastCol)).Value = CopyRange End With End Sub 

Answer 1

正如您对post的评论所指出的，这个错误来自工作记忆的不足。

每个Varianttypesvariables消耗16个字节，这就是您的代码需要大量内存的原因。 所以解决这个问题的一种方法是增加电脑的物理内存。

其他的解决scheme是过滤一定数量的行数据。

 Sub ProcessRows() Dim originalData() As Variant Dim maxRow as Long, currentRow as Long, incrementRow maxRow = ActiveSheet.Usedrange.Rows.Count currentRow =1 incrementRow=5000 While currentRow < maxRow Set originalData = Range(.Cells(currentRow,1),.Cells(currentRow+incrementRow-1,20) your process to filter data currentRow = currentRow +incrementRow Wend End Sub 

当然你也可以一个接一个地走，但是我假设你使用数组variables来加速你的代码，所以我不build议使用逐行的方法。

Answer 2

逐行工作是非常缓慢的，所以这不是一个这样一个大型数据集的可行解决scheme。

数组肯定是要走的路，所以select之间：

1. 加载批量数据，然后在一个连续的数据集上运行你的处理*（ 可行的，直到大量的数据 – 也许大约8M元素取决于你的系统）
2. 将数据批量加载，然后在批处理上运行处理（ 可以处理任意数量的数据 ）

编辑：我看你是400k * 20这是推动选项1的边界。你可能别无select，只能重构你的代码，并加载和批量处理（与批量加载，然后一起处理）

注意：

• 这应该是正常的，直到非常大的数据集作为内存不足错误首先不是从数组本身的大小，而是从工作表中读取 。
• 如果您从数组本身的大小中得到“内存不足”错误，则：
  • 你将别无select，只能使用64位Excel;
  • 或者（更好）重构你的过程来处理数据块（上面的选项2）。

下面通过recursion加载批量数据将批量数据加载到单个数组中。 尝试一下 – 在最后仍然有一个数组的好处意味着你不必重构其余的代码。

选项1的示例：

 Option Explicit Sub example() Dim myCompletedataArr Dim myTestDataRange As Range Set myTestDataRange = ActiveSheet.UsedRange loadDataInBatches myTestDataRange, myCompletedataArr Debug.Assert False End Sub Sub loadDataInBatches(dataRange As Range, dataArr, Optional startRow As Long = 1, Optional rows As Long = 10000) Dim endRow As Long, i As Long, j As Long Dim dataArrLb1 As Long, dataArrLb2 As Long, batchArrLb1 As Long, batchArrLb2 As Long Dim batchArr, batchRange As Range If Not IsArray(dataArr) Then ReDim dataArr(0 To dataRange.rows.Count - 1, 0 To dataRange.Columns.Count - 1) End If 'otherwise assume dataArr is correctly dimensioned (for simplicity) endRow = WorksheetFunction.Min(startRow + rows - 1, dataRange.rows.Count) If endRow <= startRow Then Exit Sub Set batchRange = dataRange.rows(startRow & ":" & endRow) batchArr = batchRange.Value 'cache lower bounds as we use them a lot dataArrLb1 = LBound(dataArr, 1): dataArrLb2 = LBound(dataArr, 2) batchArrLb1 = LBound(batchArr, 1): batchArrLb2 = LBound(batchArr, 2) For i = batchArrLb1 To UBound(batchArr, 1) For j = batchArrLb2 To UBound(batchArr, 2) dataArr(startRow - 1 + i + dataArrLb1 - batchArrLb1, j + dataArrLb2 - batchArrLb2) = batchArr(i, j) Next j Next i Erase batchArr 'free up some memory before the recursive call loadDataInBatches dataRange, dataArr, endRow + 1, rows End Sub