如何在VBA中垂直拼接二维数组？测试StackArrays函数失败求助

原函数存在几处易导致运行失败的问题，以下是问题分析及修复后的代码：

原函数的问题点 #

• 未显式声明result变量，易引发隐式类型错误
• 使用Integer类型存储行数/列数，Excel工作表行数（最多1048576行）远超Integer的取值上限（32767），会触发溢出错误
• 未验证输入数组的列数一致性，违背函数设计的前提假设，易导致运行时错误
• 第二个数组复制逻辑中，列数循环依赖arr2的列数，若列数不一致会导致数据复制异常

修复后的代码 #

Function StackArrays(arr1 As Variant, arr2 As Variant) As Variant
    Dim numRows As Long
    Dim numCols As Long
    Dim i As Long
    Dim j As Long
    Dim result As Variant ' 显式声明结果数组
    
    ' 验证输入为二维数组
    If UBound(arr1, 0) <> 2 Or UBound(arr2, 0) <> 2 Then
        StackArrays = "输入必须是二维数组"
        Exit Function
    End If
    
    ' 验证两数组列数一致
    numCols = UBound(arr1, 2)
    If numCols <> UBound(arr2, 2) Then
        StackArrays = "两个数组的列数必须相同"
        Exit Function
    End If
    
    numRows = UBound(arr1, 1) + UBound(arr2, 1)
    
    ' 初始化结果数组
    ReDim result(1 To numRows, 1 To numCols)
    
    ' 复制第一个数组数据
    For i = 1 To UBound(arr1, 1)
        For j = 1 To numCols
            result(i, j) = arr1(i, j)
        Next j
    Next i
    
    ' 复制第二个数组数据，简化索引计算
    For i = 1 To UBound(arr2, 1)
        For j = 1 To numCols
            result(UBound(arr1, 1) + i, j) = arr2(i, j)
        Next j
    Next i
    
    StackArrays = result
End Function

测试方法 #

1. 工作表中使用：选中足够容纳结果的单元格区域，输入公式=StackArrays(A1:C3, A5:C7)，按Ctrl+Shift+Enter完成数组输入（Excel 365及后续版本支持动态数组，直接按Enter即可）
2. VBA代码中测试：

Sub TestStack()
    Dim arr1 As Variant, arr2 As Variant, stackedArr As Variant
    arr1 = Range("A1:C3").Value
    arr2 = Range("A5:C7").Value
    stackedArr = StackArrays(arr1, arr2)
    Range("A9:C11").Value = stackedArr
End Sub

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