Excel 上的 VBA "Out of Memory"错误

Question

我使用的是 Excel 2010，工作表确实非常大(40 万行 X 20 列)。

我的代码旨在:

• 将整个工作表加载到数组中
• 检查每一行是否符合特定条件
• 符合条件的行将复制到另一个数组
• 最后将第二个数组返回到另一个工作表
• 第二个数组最终将约为原始数组的 90%

我编写了两个变量数组的定义作为变体并尝试通过复制工作表内容两次来初始化它们。

第一个副本有效，但到了第二个副本时，我遇到了“内存不足”错误。

如果有解决方法，您有什么想法吗？或者这只是 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

正如您帖子中的评论所示，此错误是由于工作内存不足造成的。

每个 Variant 类型变量占用 16 个字节，这就是您的代码需要大量内存的原因。因此，解决此问题的一种方法是增加计算机上的物理内存。

其他解决方案是按一定数量的行过滤数据。

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 

当然你可以使用逐行方法，但我假设你使用数组变量来加速你的代码，所以我不建议使用逐行方法。