Excel VBA实现每行第6列数据的动态平均值计算

我完全懂你的痛点！你要计算每行里每隔6列的单元格平均值，而且表格每天都会在最后一列（存平均值的列）左边新增6列，之前用宏录制得到的是硬编码的单元格地址，根本没法动态更新；自己写的循环又每次只把单个单元格的值赋值给结果单元格，最后得到的只是最后一个符合条件的单元格的值，不是真正的平均值对吧？

问题出在你原来的循环里，每次都直接把单个单元格的“平均值”（其实就是单元格本身的值）覆盖到目标单元格，所以循环结束后只留下了最后一个单元格的值。正确的思路应该是先把所有需要计算的单元格收集到一个Range对象里，再对这个整体求平均值。

给你修改后的代码，完全适配动态新增列的场景：

Sub CalculateDynamicRowAverage()
    Dim rng As Range
    Dim targetCell As Range
    Dim avgRange As Range
    Dim i As Integer
    
    ' 这里假设你已经把表格范围赋值给rng了，比如：
    ' Set rng = ThisWorkbook.Sheets("你的工作表名").Range("A3:HE3")
    ' 注意：最后一列必须是用来存放平均值的列
    
    ' 指定当前行要放平均值的单元格（表格最后一列的第3行）
    Set targetCell = rng.Cells(3, rng.Columns.Count)
    ' 初始化存放待计算单元格的范围
    Set avgRange = Nothing
    
    ' 从第8列开始（对应你原来的I3列，根据你的实际起始列调整），步长6，遍历到平均值列的前一列
    For i = 8 To rng.Columns.Count - 1 Step 6
        If avgRange Is Nothing Then
            ' 第一次循环，把第一个符合条件的单元格赋值给avgRange
            Set avgRange = rng.Cells(3, i)
        Else
            ' 后续循环，用Union把新的单元格合并到avgRange里
            Set avgRange = Union(avgRange, rng.Cells(3, i))
        End If
    Next i
    
    ' 计算平均值并赋值，避免没有符合条件单元格时出错
    If Not avgRange Is Nothing Then
        targetCell.Value = Application.WorksheetFunction.Average(avgRange)
    Else
        targetCell.Value = "" ' 没有符合条件的单元格就清空
    End If
End Sub

关键代码解释： #

• Union方法：这是核心！它能把多个不连续的单元格合并成一个Range对象，这样我们就能一次性对所有符合条件的单元格求平均值，而不是每次覆盖结果。
• rng.Columns.Count - 1：因为最后一列是用来存平均值的，所以循环时要排除它，只遍历到平均值列的前一列，这样新增的6列也会被自动包含进来。
• 空值判断：初始化avgRange为Nothing，并在最后判断它是否存在，防止表格没有符合条件的单元格时出现运行错误。

如果你的表格有多行需要计算，只需要再加一层行循环就行，比如：

Sub CalculateDynamicAverageForAllRows()
    Dim rng As Range
    Dim targetCell As Range
    Dim avgRange As Range
    Dim i As Integer
    Dim rowNum As Integer
    
    ' 假设你的表格范围是A3到HE10（多行）
    Set rng = ThisWorkbook.Sheets("你的工作表名").Range("A3:HE10")
    
    ' 遍历表格的每一行
    For rowNum = 1 To rng.Rows.Count
        Set targetCell = rng.Cells(rowNum, rng.Columns.Count)
        Set avgRange = Nothing
        
        ' 遍历当前行的每隔6列的单元格
        For i = 8 To rng.Columns.Count - 1 Step 6
            If avgRange Is Nothing Then
                Set avgRange = rng.Cells(rowNum, i)
            Else
                Set avgRange = Union(avgRange, rng.Cells(rowNum, i))
            End If
        Next i
        
        ' 赋值平均值
        If Not avgRange Is Nothing Then
            targetCell.Value = Application.WorksheetFunction.Average(avgRange)
        Else
            targetCell.Value = ""
        End If
    Next rowNum
End Sub

这样不管你每天新增多少组6列，代码都会自动识别所有符合条件的单元格，计算出正确的动态平均值啦！

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