使用Excel VBA为动态OLAP数据透视表在行末添加适配Last N周期的平均值列

修正后可直接使用的VBA代码 #

Sub AddAverageColumn()
    Dim ws As Worksheet
    Dim pivotLastCol As Long, avgCol As Long, avgRowStart As Long, avgRowEnd As Long
    Dim periodNum As Integer
    Dim cell As Range
    
    Set ws = Worksheets("City Sheet")
    
    '删除已存在的平均列
    For Each cell In ws.Range("B5:XFD5")
        If cell.Value = "Average" Then cell.EntireColumn.Delete
    Next cell
    
    '根据D2单元格内容匹配计算周期
    Select Case Trim(ws.Range("D2").Value)
        Case "Last 2": periodNum = 2
        Case "Last 5": periodNum = 5
        Case "Last 10": periodNum = 10
        Case Else: MsgBox "D2单元格内容不合法，仅支持Last 2/Last 5/Last 10": Exit Sub
    End Select
    
    '定位透视表最后一列，自动排除总计列
    pivotLastCol = ws.Range("XFD5").End(xlToLeft).Column
    If LCase(ws.Cells(5, pivotLastCol).Value) Like "*总计*" Or LCase(ws.Cells(5, pivotLastCol).Value) Like "*total*" Then
        pivotLastCol = pivotLastCol - 1
    End If
    
    '确定平均列位置并写入表头
    avgCol = pivotLastCol + 1
    ws.Cells(5, avgCol).Value = "Average"
    ws.Cells(5, avgCol).Font.Bold = True
    
    '定位数据行范围（默认B列为行标签列，无空值）
    avgRowStart = 6
    avgRowEnd = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
    
    '写入平均值公式并自动填充
    ws.Cells(avgRowStart, avgCol).FormulaR1C1 = "=AVERAGE(RC[" & -(periodNum) & "]:RC[-1])"
    ws.Cells(avgRowStart, avgCol).AutoFill Destination:=ws.Range(ws.Cells(avgRowStart, avgCol), ws.Cells(avgRowEnd, avgCol))
    
    '如果需要公式转固定值，取消注释下一行即可
    'ws.Range(ws.Cells(avgRowStart, avgCol), ws.Cells(avgRowEnd, avgCol)).Value = ws.Range(ws.Cells(avgRowStart, avgCol), ws.Cells(avgRowEnd, avgCol)).Value
End Sub

切片器更新自动触发配置 #

要实现切片器调整时自动删除旧平均列、避免覆盖报错，需要配置工作表事件：

1. 右键点击City Sheet工作表标签，选择「查看代码」进入VBA工作表编辑界面
2. 粘贴以下事件代码：

Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
    '透视表更新前先删除旧平均列，避免覆盖提示
    Dim cell As Range
    For Each cell In Me.Range("B5:XFD5")
        If cell.Value = "Average" Then cell.EntireColumn.Delete
    Next cell
    '等待透视表更新完成后重新生成平均列
    Application.OnTime Now + TimeValue("00:00:01"), "AddAverageColumn"
End Sub

3. 保存文件为*启用宏的工作簿（.xlsm格式）*即可生效

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