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

Question

我在 Excel 2010 上，在一张公认的非常大的工作表上（400k 行 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 

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

Answer 2

逐行工作非常慢，因此对于如此大的数据集，这不是一个可行的解决方案。

数组绝对是要走的路，所以选择是：

1. 批量加载数据，然后在连续数据集上运行您的处理 *（直到大量数据才可行 - 可能大约 8M 元素取决于您的系统）
2. 批量加载数据，然后仅在批处理上运行处理（适用于任意数量的数据）

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

笔记：

• 这应该没问题，直到非常大的数据集，因为内存不足错误起初不是来自数组本身的大小，而是来自工作表的读取。
• 如果从数组本身的大小中得到内存不足错误，则：
  • 您别无选择，只能使用 64 位 Excel；
  • 或者（更好）重构您的程序以分块处理数据（上面的选项 2）。

下面通过递归批量加载数据，将数据批量加载到单个数组中。 试试看 - 最后仍然有一个数组的好处意味着您不必重构其余的代码。

选项 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

Answer 3

上面的所有建议都表明内存不足。 我的电脑有足够的内存，我也曾经尝试切换到 64 位 Excel。 我必须假设有一个常见的 Excel 错误。 对我来说最安全的方法（不保证每次都发生）如下：由于我的 Excel 文件经常崩溃的内置效果，我将 .xlsx 文件中的数据和所有宏分离到 AddIns 中。 这种不方便的方式将崩溃几乎减少到零。 但是，每当我需要对 AddIn 进行更新时，我首先卸载 AddIn，然后修改 AddIn 的源文件，保存这个 .xlsb 文件，然后将其另存为 .xlam。 当我尝试关闭插件的源文件（.xlsb 文件）时，系统会询问我是要保存新副本还是覆盖更改。 无论我采取什么选择，我都会收到“内存不足”的消息。 有时我可以继续工作，有时 Excel 崩溃并重新开始。 也许这个描述解释了该消息与内存太少或分配的数据太多无关。