如何使用VBA实现两个数组按交替顺序合并

核心逻辑兼容两个数组长度不一致的场景：短数组元素遍历完成后，长数组剩余元素直接追加到结果末尾，合并逻辑符合如下规则：
交替合并逻辑示例：数组1为[a1,a2,a3,a4]、数组2为[b1,b2,b3]，合并输出结果为[a1,b1,a2,b2,a3,b3,a4]

完整实现代码 #

Function AlternateMergeArr(arr1 As Variant, arr2 As Variant) As Variant
    Dim i As Long, j As Long, maxLen As Long
    Dim resArr As Variant
    ' 校验输入合法性
    If Not IsArray(arr1) Or Not IsArray(arr2) Then
        Err.Raise vbObjectError + 1001, , "输入参数必须为数组"
    End If
    If UBound(arr1, 1) - LBound(arr1, 1) + 1 = 0 Or UBound(arr2, 1) - LBound(arr2, 1) + 1 = 0 Then
        Err.Raise vbObjectError + 1002, , "输入数组不能为空"
    End If
    
    ' 计算数组长度与结果数组容量
    Dim len1 As Long, len2 As Long
    len1 = UBound(arr1) - LBound(arr1) + 1
    len2 = UBound(arr2) - LBound(arr2) + 1
    maxLen = IIf(len1 > len2, len1, len2)
    ReDim resArr(0 To len1 + len2 - 1)
    
    ' 交替填充结果数组
    j = 0
    For i = 0 To maxLen - 1
        If i < len1 Then
            resArr(j) = arr1(LBound(arr1) + i)
            j = j + 1
        End If
        If i < len2 Then
            resArr(j) = arr2(LBound(arr2) + i)
            j = j + 1
        End If
    Next i
    
    AlternateMergeArr = resArr
End Function

调用示例 #

Sub TestMerge()
    Dim arrA, arrB, resArr
    ' 测试用输入数组
    arrA = Array("a1", "a2", "a3", "a4")
    arrB = Array("b1", "b2", "b3")
    ' 调用合并函数
    resArr = AlternateMergeArr(arrA, arrB)
    
    ' 结果验证：输出到立即窗口查看
    Dim k As Long
    For k = LBound(resArr) To UBound(resArr)
        Debug.Print resArr(k)
    Next k
End Sub

注意事项 #

• 输入的两个数组需为一维数组，若为多维数组可先做降维处理后再调用函数
• 如果数组是从Excel单元格区域读取的，需先使用Transpose函数转置为一维数组再传入
• 代码兼容下标不从0开始的数组场景，无需提前调整数组起始下标

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