为何无法读取多工作表内容并合并至单个Variant？

原代码存在的问题 #

• 未初始化数组：直接对arrData(0,15)赋值会触发下标越界错误，因为数组未分配存储空间
• 索引逻辑错误：VBA中从工作表Range读取的数组默认是1基索引（行、列均从1开始），原代码使用0基索引不符合规则
• 行数计算错误：lastSheetLine是工作表最后一行行号，从A2到该行的有效数据行数应为lastSheetLine - 1，直接累加行号会导致数组空间计算偏差
• 冗余工作表引用：Worksheets(ws.name)可直接替换为ws，重复查找工作表会浪费性能

优化后的实现代码 #

Dim ws As Worksheet
Dim arrData As Variant
Dim totalRows As Long
Dim currentRow As Long
Dim sheetRows As Long
Const FIXED_COLUMNS As Integer = 15 ' 固定15列，便于维护

' 1. 先统计所有工作表的有效数据总行数（跳过表头行A1）
totalRows = 0
For Each ws In ThisWorkbook.Worksheets
    sheetRows = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row - 1
    If sheetRows > 0 Then ' 跳过空表或仅含表头的表
        totalRows = totalRows + sheetRows
    End If
Next ws

' 2. 初始化数组（1基索引，匹配Range生成的数组格式）
If totalRows > 0 Then
    ReDim arrData(1 To totalRows, 1 To FIXED_COLUMNS)
    currentRow = 1 ' 记录数组当前填充的起始位置
    
    ' 3. 逐个读取工作表数据并填充到数组
    For Each ws In ThisWorkbook.Worksheets
        sheetRows = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row - 1
        If sheetRows > 0 Then
            ' 临时存储当前工作表的数据
            Dim tempArr As Variant
            tempArr = ws.Range("A2:O" & (sheetRows + 1)).Value
            
            ' 将临时数组数据复制到目标数组
            Dim i As Long
            For i = 1 To sheetRows
                arrData(currentRow + i - 1, 1 To FIXED_COLUMNS) = tempArr(i, 1 To FIXED_COLUMNS)
            Next i
            
            currentRow = currentRow + sheetRows
        End If
    Next ws
Else
    MsgBox "未检测到有效数据"
End If

关键说明 #

• 预分配数组空间：提前统计总行数后用ReDim初始化数组，避免动态扩容的性能损耗，适合处理10万行级别的数据
• 纯数组操作：避免使用剪贴板，直接通过数组赋值完成数据转移，速度更快且不受外部干扰
• 空表过滤：加入sheetRows > 0的判断，跳过无数据的工作表，避免无效操作
• 常量定义列数：用Const固定列数，后续修改列数只需调整常量值，提升代码可维护性

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