请求编写Excel宏：每隔2行复制季度平均值公式

我来帮你搞定这个宏的完善，刚好能精准实现你要在第6、9、12…每隔3行批量应用季度平均值公式的需求～

完整宏代码（带注释） #

Sub ApplyQuarterlyAverageFormula()
    Dim ws As Worksheet
    Dim LastRow As Long
    Dim currentRow As Long
    
    ' 指定要操作的工作表，可替换成你的目标表名，比如Sheets("销售数据")
    Set ws = ActiveSheet
    
    With ws
        ' 获取C列最后一行有数据的行号，作为循环的终止点
        LastRow = .Cells(.Rows.Count, "C").End(xlUp).Row
        
        ' 从第6行开始，每隔3行执行一次公式复制
        currentRow = 6
        Do While currentRow <= LastRow
            ' 将R6:U6的公式完整复制到当前行的R-U列
            .Range("R" & currentRow & ":U" & currentRow).Formula = .Range("R6:U6").Formula
            ' 跳转到下一个目标行（每次加3）
            currentRow = currentRow + 3
        Loop
    End With
    
    MsgBox "季度平均值公式已批量应用完成！", vbInformation
End Sub

代码关键点说明 #

• 工作表指定：开头先明确操作的工作表，避免误操作其他表，你可以把ActiveSheet改成具体的工作表名称（比如Sheets("Sheet1")）。
• 循环逻辑：用Do While循环从第6行开始，每次递增3，完美匹配你要的6、9、12…行的规律，直到超过C列最后一行数据的行号。
• 公式复制：直接通过.Formula属性复制R6:U6的公式，这样公式里的相对引用会自动适配当前行（比如原公式引用E6:P6，复制到第9行时会自动变成E9:P9），绝对引用也会原样保留。

额外小提示 #

如果你的R6:U6公式是固定的季度平均值（比如=AVERAGE(E6:P6)这类），也可以直接在循环里写公式内容，比如：

.Range("R" & currentRow & ":U" & currentRow).Formula = "=AVERAGE(E" & currentRow & ":P" & currentRow & ")"

这种方式适合公式比较简单的场景，不用依赖R6:U6的原有公式。

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