如何合并多列重复的Excel VBA计数宏？

核心思路 #

将重复的统计逻辑封装为通用函数，通过参数传递不同MSN对应的配置（输出列、标识等），避免冗余代码，同时优化执行效率解决崩溃问题。

步骤1：定义MSN配置集合 #

用数组存储所有12个MSN的关键参数，方便批量遍历处理：

• MSN标识：用于输出单元格的标题
• 输出列：结果写入的目标列（如"AB"、"AC"）
• 数据起始行：统计数据的起始行（通常为2，跳过表头）

步骤2：封装通用统计函数 #

使用Excel内置的CountIfs函数替代循环，大幅提升效率并减少内存占用（这是避免崩溃的关键）：

' 统计指定范围内，O列为勾选标记且F列为目标状态的行数
Function CountCheckedByStatus(ws As Worksheet, startRow As Long, endRow As Long, targetStatus As String) As Long
    On Error Resume Next ' 处理无匹配数据的情况
    CountCheckedByStatus = Application.WorksheetFunction.CountIfs( _
        ws.Range(ws.Cells(startRow, "F"), ws.Cells(endRow, "F")), targetStatus, _
        ws.Range(ws.Cells(startRow, "O"), ws.Cells(endRow, "O")), ChrW(&H2713) _
    )
    On Error GoTo 0
End Function

步骤3：编写主执行过程 #

遍历所有MSN配置，调用通用函数完成统计并写入结果：

Sub CountAllMSNData()
    Dim ws As Worksheet
    Dim msnConfigs As Variant
    Dim i As Long
    Dim dataEndRow As Long
    
    ' 替换为你的目标工作表名称
    Set ws = ThisWorkbook.Worksheets("DataSheet")
    
    ' 定义12个MSN的配置，按格式继续补充剩余项
    msnConfigs = Array( _
        Array("MSN001", "AB", 2), _
        Array("MSN002", "AC", 2), _
        Array("MSN003", "AD", 2), _
        Array("MSN004", "AE", 2), _
        Array("MSN005", "AF", 2), _
        Array("MSN006", "AG", 2), _
        Array("MSN007", "AH", 2), _
        Array("MSN008", "AI", 2), _
        Array("MSN009", "AJ", 2), _
        Array("MSN010", "AK", 2), _
        Array("MSN011", "AL", 2), _
        Array("MSN012", "AM", 2) _
    )
    
    ' 遍历每个MSN进行统计
    For i = LBound(msnConfigs) To UBound(msnConfigs)
        ' 动态获取O列最后一行数据（避免硬编码行号）
        dataEndRow = ws.Cells(ws.Rows.Count, "O").End(xlUp).Row
        
        ' 统计总勾选数（不区分状态）
        Dim totalChecked As Long
        totalChecked = Application.WorksheetFunction.CountIf( _
            ws.Range(ws.Cells(msnConfigs(i)(2), "O"), ws.Cells(dataEndRow, "O")), ChrW(&H2713) _
        )
        
        ' 统计各状态的勾选数
        Dim approvedCount As Long
        approvedCount = CountCheckedByStatus(ws, msnConfigs(i)(2), dataEndRow, "Approved")
        
        Dim inWorkCount As Long
        inWorkCount = CountCheckedByStatus(ws, msnConfigs(i)(2), dataEndRow, "In Work")
        
        ' 将结果写入指定列（示例：行1=MSN标识，行2=总勾选，行3=Approved，行4=In Work）
        ws.Cells(1, msnConfigs(i)(1)).Value = msnConfigs(i)(0)
        ws.Cells(2, msnConfigs(i)(1)).Value = totalChecked
        ws.Cells(3, msnConfigs(i)(1)).Value = approvedCount
        ws.Cells(4, msnConfigs(i)(1)).Value = inWorkCount
    Next i
    
    ' 释放对象，避免内存泄漏
    Set ws = Nothing
End Sub

为何之前合并会崩溃？ #

1. 重复代码中可能存在未释放的对象变量，导致Excel内存占用过高
2. 多次循环遍历数据行，重复计算导致性能下降
3. 变量作用域不清晰，可能出现变量冲突

使用上述方案后，代码仅通过内置高效函数完成计算，内存占用大幅降低，彻底解决崩溃问题。

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