如何用VBA合并多个Excel文件的2D数组？报错下标越界如何解决

报错原因 #

• 变量未提前赋值就使用：第一次进入循环时，ubounddArray1、ubounddArray2还没有赋值，你直接用这两个变量定义fArray的上下限，此时变量默认值不符合数组维度要求，直接触发下标越界。
• 变量名拼写错误：扩容数组的语句中你写的是bounddArray2，漏了前缀u，未定义的变量默认值为0，导致扩容逻辑完全错误。
• 缺少数组初始化判断：没有区分第一次加载数据和后续加载数据的逻辑，第一次加载不需要扩容，直接给数组赋值即可，后续加载新数据再执行扩容逻辑。
• ReDim Preserve语法使用错误：VBA中ReDim Preserve只能修改二维数组的最后一维的大小，如果你是要纵向合并数组（按行追加，列数和单个表格一致），默认第一维是行、第二维是列的结构，是无法直接用ReDim Preserve扩容第一维的行数的。

正确实现代码 #

以下代码默认实现纵向合并所有Excel表的指定区域，按行追加到同一个二维数组，如果需要横向合并可以调整逻辑：

Option Explicit ' 强制变量声明，避免拼写错误
Sub RangeToArray()
    Dim s As String, MyFiles As String
    Dim m As Long, n As Long
    Dim dArray() As Variant, fArray() As Variant
    Dim wb As Workbook, rng As Range
    Dim firstLoad As Boolean ' 标记是否是第一次加载数据
    Dim tempArr() As Variant ' 临时数组用于转置，适配ReDim Preserve规则
    
    firstLoad = True
    MyFiles = "C:\你的文件路径\" ' 注意路径最后要加斜杠
    s = Dir(MyFiles & "*.xls")
    
    Do While s <> ""
        Set wb = Workbooks.Open(MyFiles & s, False, True)
        Set rng = wb.Sheets(1).Range("A1:B2") ' 可根据实际需要修改范围
        dArray = rng.Value
        wb.Close SaveChanges:=False
        
        If firstLoad Then
            ' 第一次加载直接赋值，同时转置数组，让行数变成最后一维方便后续扩容
            fArray = WorksheetFunction.Transpose(dArray)
            firstLoad = False
        Else
            ' 后续加载先扩容数组的最后一维（也就是原数组的行维度）
            ReDim Preserve fArray(1 To UBound(fArray, 1), 1 To UBound(fArray, 2) + UBound(dArray, 1))
            ' 把新读取的数组内容写入扩容后的位置
            For m = 1 To UBound(dArray, 1)
                For n = 1 To UBound(dArray, 2)
                    fArray(n, UBound(fArray, 2) - UBound(dArray, 1) + m) = dArray(m, n)
                Next n
            Next m
        End If
        
        s = Dir
    Loop
    
    ' 合并完成后转置回原来的 行x列 结构
    If Not firstLoad Then
        fArray = WorksheetFunction.Transpose(fArray)
        ' 这里可以加代码使用fArray，比如输出到当前工作表：Range("A1").Resize(UBound(fArray,1),UBound(fArray,2)) = fArray
    End If
End Sub

如果你的需求是横向合并（按列追加，行数和单个表格一致），可以用更简单的逻辑，不需要转置：

Option Explicit
Sub RangeToArray_Horizontal()
    Dim s As String, MyFiles As String
    Dim m As Long, n As Long
    Dim dArray() As Variant, fArray() As Variant
    Dim wb As Workbook, rng As Range
    Dim firstLoad As Boolean
    
    firstLoad = True
    MyFiles = "C:\你的文件路径\"
    s = Dir(MyFiles & "*.xls")
    
    Do While s <> ""
        Set wb = Workbooks.Open(MyFiles & s, False, True)
        Set rng = wb.Sheets(1).Range("A1:B2")
        dArray = rng.Value
        wb.Close SaveChanges:=False
        
        If firstLoad Then
            fArray = dArray
            firstLoad = False
        Else
            ' 列是最后一维，直接扩容
            ReDim Preserve fArray(1 To UBound(fArray, 1), 1 To UBound(fArray, 2) + UBound(dArray, 2))
            For m = 1 To UBound(dArray, 1)
                For n = 1 To UBound(dArray, 2)
                    fArray(m, UBound(fArray, 2) - UBound(dArray, 2) + n) = dArray(m, n)
                Next n
            Next m
        End If
        
        s = Dir
    Loop
End Sub

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