多工作表非零数据统计至汇总表的VBA代码调试需求

原代码问题排查 #

• 排除工作表名称错误：需求是排除「summary」，但代码中判断的是ws.name <> "cover"，导致目标排除表没被跳过，反而错误跳过了cover表。
• 未指定CountIf的工作表范围：Range("D4:E6")默认指向当前活动工作表，而非正在遍历的ws，所以所有统计结果都是同一张表的数据，不是对应工作表的真实值。
• 数组初始化不合理：ReDim Preserve arrTotalSum(1 To .Worksheets.Count, 1 To 2)用总工作表数作为数组上限，会导致数组存在大量空元素，且重复调整数组大小浪费资源。
• 输出目标错误：代码中用.Sheets(1)作为输出表，这不一定是「summary」表，依赖工作表顺序存在不确定性。
• 变量类型冗余：X作为计数变量，用Double类型没必要，改用Long更贴合计数场景。

修复后的代码 #

Sub SheetsSum()
    Dim ws              As Worksheet
    Dim X               As Long
    Dim arrTotalSum()   As Variant
    Dim targetWs        As Worksheet
    
    ' 指定输出目标为summary工作表
    Set targetWs = ThisWorkbook.Worksheets("summary")
    
    With ThisWorkbook
        For Each ws In .Worksheets
            ' 跳过summary工作表
            If ws.Name <> "summary" Then
                X = X + 1
                ' 动态调整数组大小，仅保留已统计的行数
                ReDim Preserve arrTotalSum(1 To X, 1 To 2)
                ' 记录对应工作表名称
                arrTotalSum(X, 1) = "Quantity  " & ws.Name
                ' 明确统计当前遍历工作表的D4:E6区域
                arrTotalSum(X, 2) = Application.WorksheetFunction.CountIf(ws.Range("D4:E6"), ">0")
            End If
        Next ws
        
        ' 有统计结果时再写入，避免空数组报错
        If X > 0 Then
            targetWs.Range("A1").Resize(X, 2).Value = arrTotalSum
        End If
    End With
End Sub

修复说明 #

• 修正排除逻辑：将判断条件改为ws.Name <> "summary"，确保跳过目标工作表。
• 限定统计范围：给Range添加ws.前缀，明确统计当前遍历的工作表数据。
• 优化数组调整：每次ReDim Preserve时用当前计数X作为数组第一维上限，避免产生空元素。
• 明确输出目标：直接获取「summary」工作表对象，消除依赖工作表顺序的风险。
• 增加安全判断：当没有符合条件的工作表时，跳过写入操作，防止报错。
• 调整变量类型：将X改为Long类型，更适合整数计数场景。

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