如何用VBA根据起止数值生成子数组并合并为最终数组？

需求概述 #

需要根据多组起止数值生成对应子序列，合并为一个连续的最终数组后，仅将最终结果输出到工作表中。例如：

• 子序列1：2~6 → [2,3,4,5,6]
• 子序列2：12~15 → [12,13,14,15]
• 子序列3：20~23 → [20,21,22,23]
• 最终合并结果：[2,3,4,5,6,12,13,14,15,20,21,22,23]

替代原有直接在单元格生成单个序列的代码，改为全程在内存数组中处理数据，提升效率。

解决方案代码 #

方案1：直接合并的主过程

Sub GenerateCombinedSequence()
    Dim ws As Worksheet
    Dim startEndPairs As Variant
    Dim finalArr As Variant
    Dim i As Long, j As Long, currentIndex As Long
    Dim totalLength As Long
    
    ' 指定目标工作表，可根据实际修改
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    
    ' 定义多组起止数值对，实际使用时可替换为表单输入/单元格读取值
    startEndPairs = Array(Array(2, 6), Array(12, 15), Array(20, 23))
    
    ' 计算最终数组的总长度，避免频繁调整数组大小
    totalLength = 0
    For i = LBound(startEndPairs) To UBound(startEndPairs)
        totalLength = totalLength + (startEndPairs(i)(1) - startEndPairs(i)(0) + 1)
    Next i
    
    ' 初始化最终数组
    ReDim finalArr(1 To totalLength)
    currentIndex = 1
    
    ' 遍历每组起止对，生成子序列并合并到最终数组
    For i = LBound(startEndPairs) To UBound(startEndPairs)
        For j = startEndPairs(i)(0) To startEndPairs(i)(1)
            finalArr(currentIndex) = j
            currentIndex = currentIndex + 1
        Next j
    Next i
    
    ' 一次性将最终数组输出到工作表（从A1开始列方向填充）
    ws.Range("A1").Resize(UBound(finalArr), 1).Value = Application.Transpose(finalArr)
End Sub

方案2：模块化辅助函数（复用性更强）

先定义生成单个起止序列的辅助函数：

Function GetSequenceArray(startNum As Long, endNum As Long) As Variant
    Dim arr As Variant
    Dim i As Long
    
    ' 处理起始值大于结束值的异常情况
    If endNum < startNum Then
        GetSequenceArray = Empty
        Exit Function
    End If
    
    ReDim arr(1 To endNum - startNum + 1)
    For i = 1 To UBound(arr)
        arr(i) = startNum + i - 1
    Next i
    
    GetSequenceArray = arr
End Function

再调用辅助函数完成合并：

Sub GenerateCombinedSequenceWithFunction()
    Dim ws As Worksheet
    Dim startEndPairs As Variant
    Dim finalArr As Variant
    Dim tempArr As Variant
    Dim i As Long, j As Long, currentIndex As Long
    Dim totalLength As Long
    
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    startEndPairs = Array(Array(2, 6), Array(12, 15), Array(20, 23))
    
    ' 计算总长度
    totalLength = 0
    For i = LBound(startEndPairs) To UBound(startEndPairs)
        totalLength = totalLength + (startEndPairs(i)(1) - startEndPairs(i)(0) + 1)
    Next i
    
    ReDim finalArr(1 To totalLength)
    currentIndex = 1
    
    ' 调用辅助函数生成子序列并合并
    For i = LBound(startEndPairs) To UBound(startEndPairs)
        tempArr = GetSequenceArray(startEndPairs(i)(0), startEndPairs(i)(1))
        If Not IsEmpty(tempArr) Then
            For j = LBound(tempArr) To UBound(tempArr)
                finalArr(currentIndex) = tempArr(j)
                currentIndex = currentIndex + 1
            Next j
        End If
    Next i
    
    ' 输出到工作表
    ws.Range("A1").Resize(UBound(finalArr), 1).Value = Application.Transpose(finalArr)
End Sub

关键说明 #

1. 内存数组处理：全程在内存中生成、合并数组，避免频繁操作单元格，大幅提升数据量大时的运行效率。
2. 灵活的起止对输入：startEndPairs 可替换为表单控件输入值（如用户窗体的文本框）或从指定单元格区域读取，适配不同的输入场景。
3. 异常处理：方案2的辅助函数加入了起始值大于结束值的判断，避免生成无效序列。
4. 一次性输出：使用 Resize + Transpose 一次性将数组写入工作表，比逐个单元格赋值高效得多。

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