VBA实现数据求平均并标记是否为平均值的方法

需求说明 #

输入表格包含同一受试者不同时间点的数据，同一受试者同一时间点可能有多条记录或仅单条记录。需通过VBA遍历输入表，计算数据列平均值，生成每个受试者每个时间点仅一行的浓缩输出表，并标记该数值是否为平均值（无需统计参与平均的点数）。

实现思路 #

• 以受试者ID和时间点作为唯一组合键，分组聚合数据
• 用字典存储每个键对应的所有数据值，避免重复遍历提升效率
• 聚合完成后将结果写入新工作表，同步添加"是否为平均值"标记列

VBA代码实现 #

Sub GenerateCondensedTable()
    Dim wsInput As Worksheet, wsOutput As Worksheet
    Dim lastRow As Long, i As Long, outputRow As Long
    Dim dict As Object, key As String
    Dim dataVals As Collection, avgVal As Double
    Dim isAvg As String
    
    ' 指定输入工作表，替换为你的实际表名
    Set wsInput = ThisWorkbook.Worksheets("输入表")
    ' 创建或复用输出工作表
    On Error Resume Next
    Set wsOutput = ThisWorkbook.Worksheets("浓缩输出表")
    If Err.Number <> 0 Then
        Set wsOutput = ThisWorkbook.Worksheets.Add(After:=wsInput)
        wsOutput.Name = "浓缩输出表"
    End If
    On Error GoTo 0
    
    ' 初始化输出表
    wsOutput.Cells.ClearContents
    wsInput.Rows(1).Copy wsOutput.Rows(1)
    wsOutput.Cells(1, wsInput.UsedRange.Columns.Count + 1).Value = "是否为平均值"
    
    ' 用字典存储分组数据
    Set dict = CreateObject("Scripting.Dictionary")
    lastRow = wsInput.Cells(wsInput.Rows.Count, 1).End(xlUp).Row
    
    ' 遍历输入表数据行（跳过表头）
    For i = 2 To lastRow
        ' 生成唯一分组键：ID+时间点（默认第1列ID，第2列时间点）
        key = wsInput.Cells(i, 1).Value & "|" & wsInput.Cells(i, 2).Value
        ' 读取数据列值（默认第3列是待计算数据）
        If IsNumeric(wsInput.Cells(i, 3).Value) Then
            If Not dict.Exists(key) Then
                Set dataVals = New Collection
                dataVals.Add wsInput.Cells(i, 3).Value
                dict.Add key, dataVals
            Else
                dict(key).Add wsInput.Cells(i, 3).Value
            End If
        End If
    Next i
    
    ' 将聚合结果写入输出表
    outputRow = 2
    For Each key In dict.Keys
        ' 拆分分组键
        Dim idPart As String, timePart As String
        idPart = Split(key, "|")(0)
        timePart = Split(key, "|")(1)
        
        ' 计算平均值
        Set dataVals = dict(key)
        avgVal = 0
        For Each val In dataVals
            avgVal = avgVal + val
        Next val
        avgVal = avgVal / dataVals.Count
        
        ' 标记是否为平均值
        isAvg = IIf(dataVals.Count > 1, "是", "否")
        
        ' 写入数据
        wsOutput.Cells(outputRow, 1).Value = idPart
        wsOutput.Cells(outputRow, 2).Value = timePart
        wsOutput.Cells(outputRow, 3).Value = Round(avgVal, 2) ' 可调整小数位数
        wsOutput.Cells(outputRow, 4).Value = isAvg
        
        outputRow = outputRow + 1
    Next key
    
    ' 自动适配列宽
    wsOutput.UsedRange.Columns.AutoFit
    MsgBox "浓缩表生成完成！", vbInformation
End Sub

代码调整说明 #

• 若你的数据列位置不同，修改代码中对应列号即可（比如第4列是数据，就把wsInput.Cells(i,3)改成wsInput.Cells(i,4)）
• 标记规则可自定义：当前逻辑是单条记录标记"否"，多条记录标记"是"，可直接修改IIf语句的返回值
• 数值保留小数位数可通过Round函数的第二个参数调整

内容的提问来源于stack exchange，提问作者Rae Van Sandt