如何在VBA中创建指定数量n的数组，实现多列批量低耗时计算

核心优化逻辑 #

• 全程内存运算：避免逐单元格读写，所有输入数据一次性读入内存数组，计算完成后一次性写入工作表，6万行级数据也能保持低耗时
• 无需循环创建多个数组：提前计算输出维度，直接生成二维结果数组，每一列对应一个输入列的计算结果，减少内存开销
• 额外提速配置：运行时关闭Excel屏幕刷新、事件触发、自动计算，完成后恢复，避免不必要的性能消耗

完整可运行代码 #

Option Explicit

Private Sub MultiColCalc()
    ' ===== 配置项：按需修改 =====
    Const startRow As Long = 2                     ' 数据起始行
    Dim inputCols() As Variant                     ' 需要计算的输入列，支持多列
    inputCols = Array(2, 3, 5)                     ' 示例：计算B列、C列、E列，可自行增减
    Const firstOutputCol As Long = 4               ' 第一个结果列的列号，后续结果自动向右排列
    Const wsName As String = "Sheet1"              ' 数据所在工作表名
    ' ==========================
    
    ' 运行前关闭Excel冗余功能提速
    Dim preScreenUpdating As Boolean, preEnableEvents As Boolean, preCalc As XlCalculation
    preScreenUpdating = Application.ScreenUpdating
    preEnableEvents = Application.EnableEvents
    preCalc = Application.Calculation
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets(wsName)
    
    ' 统一计算所有输入列的最大行，避免重复计算
    Dim lastRow As Long, col As Variant
    For Each col In inputCols
        Dim currLastRow As Long
        currLastRow = ws.Cells(ws.Rows.Count, col).End(xlUp).Row
        If currLastRow > lastRow Then lastRow = currLastRow
    Next col
    If lastRow < startRow Then GoTo Finish ' 无有效数据直接退出
    
    ' 计算输出数组大小（所有输入列的输出行数一致）
    Dim inputRowCount As Long, outputSize As Long
    inputRowCount = lastRow - startRow + 1
    outputSize = (inputRowCount * (inputRowCount - 1)) / 2
    
    ' 直接创建二维结果数组，列数等于输入列数量，无需循环创建多个数组
    Dim outputArr As Variant, colCount As Long
    colCount = UBound(inputCols) - LBound(inputCols) + 1
    ReDim outputArr(1 To outputSize, 1 To colCount) As Variant
    
    ' 循环处理每一个输入列
    Dim colIndex As Long
    For colIndex = LBound(inputCols) To UBound(inputCols)
        ' 读取当前输入列数据到内存
        Dim inputArr As Variant
        inputArr = ws.Range(ws.Cells(startRow, inputCols(colIndex)), ws.Cells(lastRow, inputCols(colIndex))).Value
        
        Dim outputIndex As Long, i As Long, n As Long
        Dim currFirst As Long, currLowest As Long, testLowest As Long
        outputIndex = 0 ' 每列计算前重置输出下标
        
        ' 原逻辑保持不变，结果写入输出数组的对应列
        For i = 2 To UBound(inputArr, 1)
            currFirst = inputArr(i, 1)
            currLowest = currFirst - inputArr(i - 1, 1)
                    
            For n = i - 1 To 1 Step -1
                testLowest = currFirst - inputArr(n, 1)
                If testLowest < currLowest Then currLowest = testLowest
                outputIndex = outputIndex + 1
                outputArr(outputIndex, colIndex + 1) = currLowest
            Next n
        Next i
    Next colIndex
    
    ' 一次性写入所有结果到工作表
    ws.Cells(startRow, firstOutputCol).Resize(UBound(outputArr, 1), UBound(outputArr, 2)).Value = outputArr
    
Finish:
    ' 恢复Excel原有配置
    Application.ScreenUpdating = preScreenUpdating
    Application.EnableEvents = preEnableEvents
    Application.Calculation = preCalc
    If Err.Number <> 0 Then MsgBox "运行出错：" & Err.Description, vbCritical
End Sub

使用说明 #

• 按需修改代码顶部配置项区域的参数：inputCols填入你需要计算的所有输入列的列号，firstOutputCol指定第一个结果列的位置，后续列的计算结果会自动向右依次排列
• 所有计算全在内存完成，仅做一次工作表写入操作，针对6万行以上的大数据量也能保持较高运行效率

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