VBA中如何限制数组仅计算单列平均值并精简代码？

问题描述 #

现有一段VBA代码，可根据D列的重复值计算B列数据的平均值，结果符合预期。但尝试对C列执行同样的平均值计算时，代码会将B列和C列的值混合计算，无法得到C列单独的平均值。需求：

• 实现数组仅计算单列的平均值，避免多列数据混合
• 精简代码，探讨能否用Scripting.Dictionary同时处理B列和C列数据

原代码：

Dim ws5 As Worksheet:Set ws5 = ThisWorkbook.Sheets("Sheet1")

'average data 1 (this works as expected)

Dim dict As Object
Set dict = CreateObject("Scripting.Dictionary")

Dim lastRow As Long
lastRow = ws5.Cells(ws.Rows.Count, "B").End(xlUp).Row

Dim i As Long
For i = 12 To lastRow
    If ws5.Cells(i, 4).Value <> "" Then ' Column D has categories
        Dim key As Variant
        key = ws5.Cells(i, 4).Value
        If Not dict.exists(key) Then
            dict(key) = Array(ws5.Cells(i, 2).Value, 1) ' Initialize with (sum, count)
        Else
            dict(key) = Array(dict(key)(0) + ws5.Cells(i, 2).Value, dict(key)(1) + 1)
        End If
    End If
Next i

Dim resultRow As Long
resultRow = 12
For Each key In dict.keys
    ws5.Cells(resultRow, 5).Value = key ' Display the category in Column D
    ws5.Cells(resultRow, 6).Value = dict(key)(0) / dict(key)(1) ' Display average in Column F
    resultRow = resultRow + 1
Next key

'average data 2 (this does not work as I want it to)

Dim j As Long
For j = 12 To lastRow
    If ws5.Cells(j, 4).Value <> "" Then ' Column D has categories
        
        key = ws5.Cells(j, 4).Value
        If Not dict.exists(key) Then
            dict(key) = Array(ws5.Cells(j, 3).Value, 1) ' Initialize with (sum, count)
        Else
            dict(key) = Array(dict(key)(0) + ws5.Cells(j, 3).Value, dict(key)(1) + 1)
        End If
    End If
Next j


resultRow = 12
For Each key In dict.keys
    ws5.Cells(resultRow, 7).Value = dict(key)(0) / dict(key)(1) ' Display average in Column G
    resultRow = resultRow + 1
Next key

问题原因 #

计算C列平均值时，复用了存储B列统计数据的同一个dict对象，未清空原有数据，导致字典中存储的B列总和与计数被C列数据覆盖、混合，最终得到的是两列数据的混合平均值，而非C列单独的结果。

解决方案 #

方案1：分开处理（重置字典） #

在计算C列平均值前，重新创建一个新的Scripting.Dictionary对象，确保两列的统计数据完全独立：

Dim ws5 As Worksheet:Set ws5 = ThisWorkbook.Sheets("Sheet1")
Dim lastRow As Long
lastRow = ws5.Cells(ws5.Rows.Count, "D").End(xlUp).Row ' 改用D列确定最后一行更准确

' 计算B列平均值
Dim dictB As Object
Set dictB = CreateObject("Scripting.Dictionary")

Dim i As Long
For i = 12 To lastRow
    If ws5.Cells(i, 4).Value <> "" Then
        Dim key As Variant
        key = ws5.Cells(i, 4).Value
        If Not dictB.exists(key) Then
            dictB(key) = Array(ws5.Cells(i, 2).Value, 1) ' B列总和, B列计数
        Else
            dictB(key) = Array(dictB(key)(0) + ws5.Cells(i, 2).Value, dictB(key)(1) + 1)
        End If
    End If
Next i

' 输出B列结果
Dim resultRow As Long
resultRow = 12
For Each key In dictB.keys
    ws5.Cells(resultRow, 5).Value = key
    ws5.Cells(resultRow, 6).Value = dictB(key)(0) / dictB(key)(1)
    resultRow = resultRow + 1
Next key

' 计算C列平均值：创建新字典
Dim dictC As Object
Set dictC = CreateObject("Scripting.Dictionary")

Dim j As Long
For j = 12 To lastRow
    If ws5.Cells(j, 4).Value <> "" Then
        key = ws5.Cells(j, 4).Value
        If Not dictC.exists(key) Then
            dictC(key) = Array(ws5.Cells(j, 3).Value, 1) ' C列总和, C列计数
        Else
            dictC(key) = Array(dictC(key)(0) + ws5.Cells(j, 3).Value, dictC(key)(1) + 1)
        End If
    End If
Next j

' 输出C列结果
resultRow = 12
For Each key In dictC.keys
    ws5.Cells(resultRow, 7).Value = dictC(key)(0) / dictC(key)(1)
    resultRow = resultRow + 1
Next key

方案2：单字典同时处理两列（精简代码） #

让字典的每个key对应一个包含B列总和、B列计数、C列总和、C列计数的数组，只需一次遍历即可完成两列的统计，大幅精简代码：

Dim ws5 As Worksheet:Set ws5 = ThisWorkbook.Sheets("Sheet1")
Dim lastRow As Long
lastRow = ws5.Cells(ws5.Rows.Count, "D").End(xlUp).Row

Dim dict As Object
Set dict = CreateObject("Scripting.Dictionary")

Dim i As Long
For i = 12 To lastRow
    Dim key As Variant
    key = ws5.Cells(i, 4).Value
    If key <> "" Then
        If Not dict.exists(key) Then
            ' 初始化：B列总和, B列计数, C列总和, C列计数
            dict(key) = Array(ws5.Cells(i, 2).Value, 1, ws5.Cells(i, 3).Value, 1)
        Else
            ' 更新B列统计
            dict(key)(0) = dict(key)(0) + ws5.Cells(i, 2).Value
            dict(key)(1) = dict(key)(1) + 1
            ' 更新C列统计
            dict(key)(2) = dict(key)(2) + ws5.Cells(i, 3).Value
            dict(key)(3) = dict(key)(3) + 1
        End If
    End If
Next i

' 一次性输出两列结果
resultRow = 12
For Each key In dict.keys
    ws5.Cells(resultRow, 5).Value = key
    ws5.Cells(resultRow, 6).Value = dict(key)(0) / dict(key)(1) ' B列平均值
    ws5.Cells(resultRow, 7).Value = dict(key)(2) / dict(key)(3) ' C列平均值
    resultRow = resultRow + 1
Next key

方案优势对比 #

• 方案1逻辑简单，各列统计完全独立，不易出错，适合新手理解
• 方案2仅需一次遍历数据，执行效率更高，代码更精简，适合处理大量数据场景

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