如何在筛选列表中与月份行内写入基于SUBTOTAL(101)计算的月度平均值

嘿，我来帮你搞定这个需求！你现在是想把每个月用SUBTOTAL(101)算出的平均值，填充到对应月份的每一行MonthAvg列里，而不是单独存到数组再输出对吧？而且你的数据可能不是按月份排序的，这点也得考虑进去。

我给你两种可行的方案，你可以根据自己的情况选：

方案一：基于你现有代码改造，筛选后直接给可见单元格赋值 #

这个方案和你现在的逻辑衔接最紧密，就是在筛选每个月份后，直接把计算好的平均值写到该月份所有可见行的MonthAvg列里。

修改后的代码如下（记得替换成你实际的工作表名，以及确认列的位置是否正确）：

Dim lMonthCounter As Integer
Dim arrMonthAvg(11) As Single
Dim wksA As Worksheet
Dim lastRow As Long
Dim avgRange As Range

' 指定工作表，改成你实际的表名
Set wksA = ThisWorkbook.Worksheets("DataSheet")
' 获取数据区域的最后一行
lastRow = wksA.Cells(wksA.Rows.Count, "A").End(xlUp).Row

' 先取消之前的筛选，避免干扰后续操作
If wksA.AutoFilterMode Then wksA.AutoFilterMode = False

For lMonthCounter = 21 To 32
    ' 筛选对应月份（这里21-32对应1-12月，确认这个编码对应关系没问题）
    wksA.Range("A1").AutoFilter Field:=4, Criteria1:=lMonthCounter, Operator:=11, Criteria2:=0, SubField:=0
    
    ' 计算当前月份的SUBTOTAL平均值
    arrMonthAvg(lMonthCounter - 21) = Application.WorksheetFunction.Subtotal(101, wksA.Range("F:F"))
    
    ' 尝试获取MonthAvg列（假设是C列）的可见数据行（跳过表头）
    On Error Resume Next ' 处理没有可见行的情况，避免报错
    Set avgRange = wksA.Range("C2:C" & lastRow).SpecialCells(xlCellTypeVisible)
    On Error GoTo 0
    
    ' 如果找到可见行，就把平均值赋值给这些单元格
    If Not avgRange Is Nothing Then
        avgRange.Value = arrMonthAvg(lMonthCounter - 21)
        Set avgRange = Nothing ' 释放对象，避免内存占用
    End If
Next lMonthCounter

' 最后取消筛选，恢复表格状态
If wksA.AutoFilterMode Then wksA.AutoFilterMode = False

这段代码的关键点： #

• 先取消旧筛选，防止之前的筛选结果影响新的筛选
• 用SpecialCells(xlCellTypeVisible)定位当前月份的所有数据行
• 加入错误处理，避免某个月份没有数据时触发报错
• 最后记得取消筛选，让表格回到正常状态

方案二：用字典存储平均值，再遍历行填充（效率更高） #

如果你的数据量比较大，反复筛选会有点慢，那可以先把所有月份的平均值存到字典里，然后遍历每一行直接填充，不用反复切换筛选状态。

代码示例：

Dim wksA As Worksheet
Dim lastRow As Long
Dim monthDict As Object
Dim lMonthCounter As Integer
Dim cell As Range

Set wksA = ThisWorkbook.Worksheets("DataSheet")
lastRow = wksA.Cells(wksA.Rows.Count, "A").End(xlUp).Row
' 创建字典来存储月份编码和对应的平均值
Set monthDict = CreateObject("Scripting.Dictionary")

' 先取消筛选
If wksA.AutoFilterMode Then wksA.AutoFilterMode = False

' 第一步：遍历所有月份，计算平均值并存入字典
For lMonthCounter = 21 To 32
    wksA.Range("A1").AutoFilter Field:=4, Criteria1:=lMonthCounter, Operator:=11, Criteria2:=0, SubField:=0
    ' 把月份编码作为键，平均值作为值存入字典
    monthDict(lMonthCounter) = Application.WorksheetFunction.Subtotal(101, wksA.Range("F:F"))
Next lMonthCounter

' 取消筛选，回到完整数据视图
If wksA.AutoFilterMode Then wksA.AutoFilterMode = False

' 第二步：遍历所有数据行，根据月份编码从字典取值填充MonthAvg列
For Each cell In wksA.Range("D2:D" & lastRow) ' 假设月份编码在D列（对应Field:=4）
    If monthDict.Exists(cell.Value) Then
        ' C列是MonthAvg列，所以从D列往左偏移1列
        cell.Offset(0, -1).Value = monthDict(cell.Value)
    Else
        ' 如果没有对应月份的数据，填空（也可以改成0或者其他默认值）
        cell.Offset(0, -1).Value = ""
    End If
Next cell

' 释放字典对象
Set monthDict = Nothing

这个方案的优势： #

• 只需要筛选12次，然后一次遍历填充，比反复筛选+赋值的效率高
• 不管数据的排序如何，都能准确对应到每一行的月份
• 字典的键值对结构能快速匹配月份和平均值

一些注意事项： #

1. 确认你的列位置：代码里假设月份在D列（Field:=4），MonthAvg在C列，如果实际列不同，记得调整Range和Offset的参数。
2. 月份编码对应：你用21-32对应1-12月，要确保这个对应关系是正确的，否则筛选会出错。
3. 空月份处理：如果某个月份没有数据，SUBTOTAL(101)会返回0，你可以根据需求修改成空值或者其他提示内容。

备注：内容来源于stack exchange，提问作者user1769136