Error 7：将数组赋值给单元格区域时内存不足问题求助

错误原因分析 #

1. 数组容量过载：当listToGetValuesFrom指向超大单元格区域时，ReDim calculations(1 To UBound(listToGetValuesFrom.Value2), 1 To 3)会创建一个规模极大的二维数组，每个元素都是长文本公式，快速耗尽系统内存。
2. 冗余字符串操作：循环中重复拼接地址字符串，每次都会生成新的字符串对象，累积占用额外内存资源。
3. 潜在引用错误：第三列公式中counter=1时，Offset(counter-2,1)会生成无效单元格引用，可能引发额外的内存异常。

针对性解决方案 #

• 精准定义数组大小：用listToGetValuesFrom.Rows.Count直接获取区域行数，替代依赖Value2的UBound计算，避免不必要的数组维度判断。
• 预存重复变量：将循环中反复用到的地址、工作表名等提前存入变量，减少循环内的字符串拼接次数。
• 分批次写入工作表：如果处理行数超过万行，拆分数组为多个小批次逐次写入，降低单次内存占用峰值。
• 修复无效引用：对循环初始值的公式做特殊处理，避免生成无效单元格引用。

修改后的代码示例 #

Public Sub createDropDownListValidationWithSearchForCell(targetCell As Range, startingCellOfCalculations As Range, listToGetValuesFrom As Range)
    Dim calculations() As Variant
    Dim totalRows As Long
    Dim targetAddr As String
    Dim startCellAddr As String
    Dim sourceSheetName As String
    Dim secondCLetter As String
    Dim listToGetValuesFromCLetter As String
    
    ' 预存重复使用的变量，减少循环内重复计算
    totalRows = listToGetValuesFrom.Rows.Count
    targetAddr = targetCell.Address
    startCellAddr = startingCellOfCalculations.Address
    sourceSheetName = Split(listToGetValuesFrom.Address(External:=True), "$")(0)
    listToGetValuesFromCLetter = Col_Letter(listToGetValuesFrom.Column)
    secondCLetter = Col_Letter(startingCellOfCalculations.Column)
    
    ' 精准定义数组大小
    ReDim calculations(1 To totalRows, 1 To 3)
    
    For counter = 1 To totalRows
        ' 第一列公式
        calculations(counter, 1) = "=SE(ÉERRO(LOCALIZAR(" & targetAddr & ";" & listToGetValuesFrom(counter, 1).Address(External:=True) & "));0;1)"
        ' 第二列公式
        calculations(counter, 2) = "=SE(" & startingCellOfCalculations.Offset(counter - 1, 0).Address & "=0;"""";CONT.SE(" & startCellAddr & ":" & startingCellOfCalculations.Offset(counter - 1, 0).Address & ";1))"
        ' 第三列公式：处理counter=1时的无效引用
        If counter > 1 Then
            calculations(counter, 3) = "=SEERRO(ÍNDICE('" & sourceSheetName & listToGetValuesFromCLetter & ":" & listToGetValuesFromCLetter & ";CORRESP(LIN(" & startingCellOfCalculations.Offset(counter - 2, 1).Address & ");" & secondCLetter & secondCLetter & ";0));"""")"
        Else
            calculations(counter, 3) = """"""
        End If
    Next counter
    
    ' 分批次写入，降低内存占用，可根据实际调整batchSize
    Const batchSize As Long = 5000
    Dim i As Long
    For i = 1 To totalRows Step batchSize
        Dim endRow As Long
        endRow = WorksheetFunction.Min(i + batchSize - 1, totalRows)
        startingCellOfCalculations.Offset(i - 1, 0).Resize(endRow - i + 1, 3).FormulaLocal = _
            Application.Index(calculations, Evaluate("ROW(" & i & ":" & endRow & ")"), Array(1, 2, 3))
    Next i
End Sub

额外说明 #

• 分批次写入的batchSize可根据系统内存情况调整，建议取值范围在5000-20000之间。
• 若Col_Letter函数存在效率问题，可替换为Cells(1, columnNum).Address(False, False)提取列字母，进一步优化性能。

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