多工作表求和至Summary表：VBA代码故障排查与需求实现

原代码无法正确显示所有工作表合计值的核心问题是循环内重复执行ReDim重置数组，每次循环都会清空之前存储的结果，最终仅保留最后一个工作表的数据。同时还有几处细节需要优化以适配不限数量工作表的需求，以下是修复方案：

方案一：先统计数量再初始化数组（稳定可靠） #

Sub SheetsSum()
    Dim ws              As Worksheet
    Dim X               As Long ' 改用Long类型存储计数器，适配大量工作表场景
    Dim arrTotalSum()   As Variant
    Dim targetWs        As Worksheet
    
    ' 直接指定目标工作表，避免依赖工作表顺序
    Set targetWs = ThisWorkbook.Worksheets("Summary")
    X = 0 ' 初始化计数器
    
    With ThisWorkbook
        ' 第一步：统计需要处理的工作表数量
        For Each ws In .Worksheets
            If ws.Name <> "Summary" Then
                X = X + 1
            End If
        Next ws
        
        ' 仅当有需要处理的工作表时才继续
        If X > 0 Then
            ' 根据实际数量一次性初始化数组，避免重复重置
            ReDim arrTotalSum(1 To X, 1 To 2)
            X = 0 ' 重置计数器用于填充数组
            
            ' 第二步：计算求和并填充数组
            For Each ws In .Worksheets
                If ws.Name <> "Summary" Then
                    X = X + 1
                    arrTotalSum(X, 1) = "Total  " & ws.Name
                    arrTotalSum(X, 2) = Application.WorksheetFunction.Sum(ws.Range("D4:E6"))
                End If
            Next ws
            
            ' 将数组批量写入Summary表
            targetWs.Range("A1").Resize(X, 2).Value = arrTotalSum
        End If
    End With
End Sub

方案二：动态扩展数组（更简洁） #

利用ReDim Preserve动态扩展数组，无需提前统计数量，适合不确定工作表数量的场景：

Sub SheetsSum_Simpler()
    Dim ws              As Worksheet
    Dim X               As Long
    Dim arrTotalSum()   As Variant
    
    X = 0
    With ThisWorkbook
        For Each ws In .Worksheets
            If ws.Name <> "Summary" Then
                X = X + 1
                ' 仅扩展数组最后一维，保留已有数据
                ReDim Preserve arrTotalSum(1 To 2, 1 To X)
                arrTotalSum(1, X) = "Total  " & ws.Name
                arrTotalSum(2, X) = Application.WorksheetFunction.Sum(ws.Range("D4:E6"))
            End If
        Next ws
        
        If X > 0 Then
            ' 转置数组后写入（因Preserve仅支持修改最后一维，需调整结构）
            .Worksheets("Summary").Range("A1").Resize(X, 2).Value = Application.Transpose(arrTotalSum)
        End If
    End With
End Sub

关键修改说明 #

• 避免数组数据丢失：移除循环内的ReDim操作，改为一次性初始化或用Preserve扩展，确保之前的计算结果被保留
• 明确目标工作表：直接通过名称定位Summary表，避免因工作表顺序变动导致写入错误
• 优化数据类型：将计数器X改为Long类型，适配超过32767个工作表的极端场景
• 增加空判断：无符合条件的工作表时跳过写入操作，避免运行报错

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