如何将零件订单合并为单行并统计订单数、计算平均订购量？

需求与问题 #

• 核心需求：每行对应单个零件的独立订单，需统计每种零件的订单数量，计算每份订单的平均零件订购量，最终将每种零件的结果合并为单行，删除原有独立订单行。
• 当前问题：现有VBA代码存在两个缺陷：零件名称变化时会遗漏单元格；无法对目标区域的第三列求平均值。

用户现有VBA代码 #

Sub aveCount()
    
    Dim rng As Range
    Dim cl As Range
    Dim partName As String
    Dim startAddress As String
    Dim ws As Worksheet
    Dim count As Double
    Dim orders As Double
    Dim i As Integer
    
        Set ws = ActiveWorkbook.Worksheets("Sheet1")
        'lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
        Application.ScreenUpdating = False
        i = 0
        For Each cl In ws.Range("A89:A433")
            If i = 0 Then
                partName = cl.Value
            End If
            
            If cl.Value = partName Then
                i = i + 1
                
                If rng Is Nothing Then
                    startAddress = cl.Address
                    Set rng = ws.Range(cl.Address).Resize(, 4)
                Else
                    Set rng = Union(rng, ws.Range(cl.Address).Resize(, 4))
                End If
            Else
                i = 0
            End If
            count = rng.Rows.count
            ws.Range(startAddress).Offset(0, 4) = Application.WorksheetFunction.Subtotal(1, rng)
            Debug.Print (startAddress)
            Stop
     
        Next cl 'next row essentially
    
End Sub

两种实现方案 #

方案一：公式法（无VBA，快速实现） #

假设零件名称在A列，订购量在C列（可根据实际列调整）：

1. 提取唯一零件名：在空白列（如E列）输入公式 =UNIQUE(A89:A433)，自动生成所有不重复的零件名称。
2. 统计订单数量：在F列对应单元格输入 =COUNTIF(A89:A433,E1)，下拉填充得到每种零件的订单数。
3. 计算平均订购量：在G列对应单元格输入 =AVERAGEIF(A89:A433,E1,C89:C433)，下拉填充得到平均订购量。
4. 清理原数据：复制E:G列结果并粘贴为值，删除原A:D列的订单行即可。

方案二：优化后的VBA代码（自动化处理） #

解决原代码的遗漏问题，精准计算第三列平均值，自动合并结果：

Sub PartOrderStats()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim partDict As Object
    Dim partName As String
    Dim orderQty As Double
    Dim i As Long
    Dim statsRow As Long
    
    Set ws = ActiveWorkbook.Worksheets("Sheet1")
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    Set partDict = CreateObject("Scripting.Dictionary")
    Application.ScreenUpdating = False
    
    ' 遍历数据统计每个零件的订单数和总订购量
    For i = 89 To lastRow
        partName = ws.Cells(i, "A").Value
        orderQty = ws.Cells(i, "C").Value ' 第三列为订购量，按需调整列号
        
        If partDict.Exists(partName) Then
            ' 更新现有零件的统计数据
            partDict(partName) = Array(partDict(partName)(0) + 1, partDict(partName)(1) + orderQty)
        Else
            ' 新增零件的初始统计数据
            partDict(partName) = Array(1, orderQty)
        End If
    Next i
    
    ' 清空原订单数据区域
    ws.Range("A89:D" & lastRow).ClearContents
    
    ' 将统计结果写入表格
    statsRow = 89
    For Each partName In partDict.Keys
        ws.Cells(statsRow, "A").Value = partName
        ws.Cells(statsRow, "D").Value = partDict(partName)(0) ' 订单数量
        ws.Cells(statsRow, "E").Value = partDict(partName)(1) / partDict(partName)(0) ' 平均订购量
        statsRow = statsRow + 1
    Next partName
    
    Application.ScreenUpdating = True
    MsgBox "统计合并完成！"
End Sub

代码优势：

• 用字典存储数据，彻底解决零件名称变化时的遗漏问题。
• 仅遍历一次数据，统计效率更高。
• 精准针对第三列计算总订购量，再通过“总订购量/订单数”得到平均值。
• 自动清空原数据并写入合并后的结果，无需手动清理。

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