向Excel ListObject写入数组时遭遇内存不足问题求助

问题背景 #

在使用VBA将数组写入ListObject格式的Excel表格时，出现内存不足报错。部分场景运行正常，但另一个元素总数更少的场景却失败，即使取消ListObject格式转为普通单元格区域，问题依然存在。

调用逻辑代码 #

Dim SFH As New SheetFilterhandler

Set SFH.SetTable = loSourceList
SFH.SaveFilters
SFH.DisableFilters
Call UpdateListObject(loSourceList, loImportList)
SFH.EnableFilters

核心处理函数 #

Public Function UpdateListObject(loTarget As ListObject, loSource As ListObject) As Boolean

On Error GoTo CreateErr
Dim PreviousContent As Variant
Dim Export As Variant

Export = loSource.DataBodyRange.value
PreviousContent = loTarget.DataBodyRange.value

Dim CurrentContent As Variant
ReDim CurrentContent(UBound(PreviousContent) + UBound(Export), UBound(PreviousContent, 2))

For ExportIndex = 1 To UBound(Export)
    For PreviousContentIndex = 1 To UBound(PreviousContent)
        '对比Export与PreviousContent并写入CurrentContent
    Next PreviousContentIndex
    '新增项判断
    If ItemNotExisting Then
        NewContentCounter = NewContentCounter + 1
        loTarget.ListRows.Add
        For i = 1 To UBound(Export, 2)
            CurrentContent(UBound(PreviousContent) + NewContentCounter, i) = Export(ExportIndex, i)
        Next i
    End If
Next ExportIndex

loTarget.DataBodyRange.Value2 = CurrentContent '问题行
UpdateListObject = True
Exit Function
CreateErr:
    UpdateListObject = False
    GetErrMsg = Err.Description
    Debug.Print "UpdateListObject: " & GetErrMsg
    Debug.Print PreviousContentIndex & "," & ExportIndex
End Function

场景对比 #

正常运行场景 #

CurrentContent Variant/Variant(1 to 1294, 1 to 55);
loTarget.DataBodyRange.Value2(1 to 647, 1 to 55)
元素总数：71170

报错场景 #

CurrentContent Variant/Variant(1 to 3071, 1 to 20);
loTarget.DataBodyRange.Value2(1 to 1543, 1 to 20)
元素总数：61420

报错信息为德语“Nicht genügend Speicher”，翻译为内存不足。

取消ListObject格式后的测试代码 #

即使转为普通单元格区域，同样报错：

With ActiveSheet
    .ListObjects(1).Unlist
    .UsedRange.Offset(1, 0).Clear
    .Range(.Cells(2, 1), Cells(UBound(CurrentContent) + 1, UBound(CurrentContent, 2))) = CurrentContent
End With

CurrentContent示例数据 #

原因分析 #

1. Variant数组内存开销差异：虽然报错场景元素总数更少，但数组中字符串类型占比极高，而字符串型Variant的内存占用远大于数值型，导致整体内存开销超过正常场景。
2. 冗余数组空间浪费：CurrentContent预先分配了远超实际需要的行数，空Variant元素仍会占用内存，加剧内存压力。
3. 一次性写入的内存峰值：直接将大数组一次性赋值给单元格区域时，Excel需要一次性申请大量内存处理数据转换与写入，容易触发内存不足。

解决方法 #

1. 优化数组空间分配 #

仅分配实际需要的行数，避免冗余空间：

' 先统计实际需要的总行数（原有行+新增行）
Dim totalRows As Long
totalRows = UBound(PreviousContent) + NewContentCounter
ReDim CurrentContent(1 To totalRows, 1 To UBound(PreviousContent, 2))

' 复制原有内容到新数组
For i = 1 To UBound(PreviousContent)
    For j = 1 To UBound(PreviousContent, 2)
        CurrentContent(i, j) = PreviousContent(i, j)
    Next j
Next i

' 写入新增内容（原逻辑中的新增项写入代码）
' ...

2. 分批写入数组 #

将大数组拆分为小数组分批写入，降低单次内存占用：

Dim batchSize As Long
batchSize = 1000 ' 根据实际情况调整分批大小
Dim startRow As Long, endRow As Long
Dim tempArr As Variant

startRow = 1
Do While startRow <= UBound(CurrentContent)
    endRow = Application.Min(startRow + batchSize - 1, UBound(CurrentContent))
    ' 截取当前批次的数组
    ReDim tempArr(1 To endRow - startRow + 1, 1 To UBound(CurrentContent, 2))
    For i = startRow To endRow
        For j = 1 To UBound(CurrentContent, 2)
            tempArr(i - startRow + 1, j) = CurrentContent(i, j)
        Next j
    Next i
    ' 写入对应单元格区域
    loTarget.DataBodyRange.Cells(startRow, 1).Resize(endRow - startRow + 1, UBound(CurrentContent, 2)).Value2 = tempArr
    startRow = endRow + 1
Loop

3. 批量添加ListObject行 #

避免提前逐行添加行，改为统计新增行数后批量添加：

' 先统计NewContentCounter，再批量添加行
If NewContentCounter > 0 Then
    loTarget.ListRows.Add Count:=NewContentCounter
End If

4. 针对日期类型优化写入方式 #

如果数组中存在大量日期类型，使用Value代替Value2，减少类型转换的内存开销：

loTarget.DataBodyRange.Value = CurrentContent

内容的提问来源于stack exchange，提问作者olli8