VBA中ReDim Preserve调整二维数组双维度失败的解决办法

确实，VBA的ReDim Preserve仅支持调整多维数组的最后一个维度，直接像你提供的测试代码那样同时调整行（第一维）和列（第二维）会触发报错。针对你的需求——合并多工作簿数据并在每行前新增列，以下是几种可行的解决思路：

方案1：转置数组后调整维度 #

利用ReDim Preserve可调整最后一维的特性，先将二维数组转置（行变列、列变行），调整转置后的最后一维（对应原数组的行维度），再转置回原结构。适合单独调整行维度的场景。

示例代码：

Sub AdjustRowsViaTranspose()
    Dim arr As Variant
    Dim tempArr As Variant
    Dim newRowCount As Long
    Dim i As Long
    
    ' 初始化数组（示例从工作表取数）
    arr = ThisWorkbook.Sheets("数据源").Range("A1:C5").Value
    newRowCount = 10 ' 要扩展到10行
    
    ' 转置数组，将原行维度转为最后一维
    tempArr = Application.Transpose(arr)
    ' 调整转置后的数组行数（对应原数组的行）
    ReDim Preserve tempArr(1 To UBound(tempArr, 1), 1 To newRowCount)
    ' 转置回原结构
    arr = Application.Transpose(tempArr)
    
    ' 填充新增行数据
    For i = 6 To newRowCount
        arr(i, 1) = "新增行" & i
    Next i
End Sub

方案2：新建目标数组，复制原数据 #

如果需要同时调整行和列维度（比如你的每行前加列需求），直接创建一个符合目标维度的新数组，将原数据复制到对应位置，同时填充新增列的内容。这种方法直观且无转置限制，效率也更高，尤其适合大数据量场景。

针对你的项目场景，示例代码如下：

Sub MergeDataWithNewArray()
    Dim sourceArr As Variant
    Dim targetArr As Variant
    Dim totalRows As Long, totalCols As Long
    Dim wb As Workbook, ws As Worksheet
    Dim currentRow As Long, i As Long, j As Long
    
    ' 第一步：先统计所有待合并数据的总行数
    totalRows = 0
    For Each wb In Workbooks
        If wb.Name <> ThisWorkbook.Name Then
            For Each ws In wb.Sheets
                totalRows = totalRows + ws.Cells(ws.Rows.Count, "A").End(xlUp).Row - 1 ' 减去表头行
            Next ws
        End If
    Next wb
    
    ' 确定目标数组维度：总行数 + 新增2列（来源工作簿、工作表名）
    totalCols = ThisWorkbook.Sheets("模板").UsedRange.Columns.Count + 2 ' 假设模板列数是原数据列数
    ReDim targetArr(1 To totalRows, 1 To totalCols)
    
    ' 第二步：逐个工作簿/工作表复制数据并填充新增列
    currentRow = 1
    For Each wb In Workbooks
        If wb.Name <> ThisWorkbook.Name Then
            For Each ws In wb.Sheets
                sourceArr = ws.Range("A2").Resize(ws.Cells(ws.Rows.Count, "A").End(xlUp).Row - 1, totalCols - 2).Value
                ' 复制原数据到目标数组的第3列开始
                For i = 1 To UBound(sourceArr, 1)
                    targetArr(currentRow, 1) = wb.Name
                    targetArr(currentRow, 2) = ws.Name
                    For j = 1 To UBound(sourceArr, 2)
                        targetArr(currentRow, j + 2) = sourceArr(i, j)
                    Next j
                    currentRow = currentRow + 1
                Next i
            Next ws
        End If
    Next wb
    
    ' 将结果写入工作表
    ThisWorkbook.Sheets("合并结果").Range("A1").Resize(totalRows, totalCols).Value = targetArr
End Sub

方案3：用Collection暂存行数据 #

如果不确定最终数据行数，可先用Collection暂存每一行的完整数据（包括新增列），最后再将Collection转换为二维数组。这种方式无需提前计算维度，灵活度高。

示例代码：

Sub BuildArrayWithCollection()
    Dim rowCol As New Collection
    Dim rowData As Variant
    Dim targetArr As Variant
    Dim wb As Workbook, ws As Worksheet
    Dim lastRow As Long, i As Long, j As Long
    
    ' 遍历工作簿收集数据
    For Each wb In Workbooks
        If wb.Name <> ThisWorkbook.Name Then
            For Each ws In wb.Sheets
                lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
                For i = 2 To lastRow ' 跳过表头
                    ' 构建包含新增列的行数据
                    ReDim rowData(1 To 2 + ws.UsedRange.Columns.Count)
                    rowData(1) = wb.Name
                    rowData(2) = ws.Name
                    For j = 1 To ws.UsedRange.Columns.Count
                        rowData(j + 2) = ws.Cells(i, j).Value
                    Next j
                    rowCol.Add rowData
                Next i
            Next ws
        End If
    Next wb
    
    ' 将Collection转换为二维数组
    If rowCol.Count > 0 Then
        ReDim targetArr(1 To rowCol.Count, 1 To UBound(rowCol(1)))
        For i = 1 To rowCol.Count
            rowData = rowCol(i)
            For j = 1 To UBound(rowData)
                targetArr(i, j) = rowData(j)
            Next j
        Next i
        ' 写入结果
        ThisWorkbook.Sheets("合并结果").Range("A1").Resize(rowCol.Count, UBound(rowCol(1))).Value = targetArr
    End If
End Sub

各方案对比 #

• 转置法：代码简洁，但依赖Excel的Transpose函数，数据量过大时可能有限制，适合小到中等数据量。
• 新建数组法：效率最高，适合大数据量场景，尤其能提前统计总行列数的情况（如你的合并项目）。
• Collection法：灵活度高，无需提前计算维度，代码易读，但数据量极大时效率略低于直接操作数组。

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