大体积数据透视表批量修改数据源的VBA优化及替代方案咨询

你原有代码的核心性能问题是每次循环透视表时都单独新建了一个PivotCache（透视表缓存），相当于80万行的数据源要重复读取N次（N等于你工作簿里的透视表数量），这是耗时40分钟的最主要原因。优化逻辑是仅创建1次公共缓存，所有透视表复用该缓存，同时修正原有代码的语法问题、补充其他提速配置。

优化后代码： #

Sub Change_Pivot_Source()
    Dim pt As PivotTable
    Dim ws As Worksheet
    Dim month As String
    Dim monthname As String
    Dim yr As String
    Dim sharedPivotCache As PivotCache
    Dim sourcePath As String
    
    ' 拼接正确的数据源路径，修正原有引号拼接错误
    month = Format(Now(), "mm")
    monthname = WorksheetFunction.Text(Now(), "[$-en-US]mmm;@")
    yr = Format(Now, "yyyy")
    sourcePath = "'https://sharepoint.com/sites/Shared Documents/[Worksheetname " & month & "_" & monthname & " " & yr & " TotalData.xlsb]Sheet 1'!R2C1:R800000"
    
    ' 全开性能优化配置
    Application.ScreenUpdating = False
    Application.EnableAnimations = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    Application.DisplayStatusBar = False
    
    ' 仅创建1次公共缓存，所有透视表复用
    Set sharedPivotCache = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=sourcePath)
    
    For Each ws In ActiveWorkbook.Worksheets
        For Each pt In ws.PivotTables
            ' 关闭透视表中间自动更新，避免无效刷新
            pt.ManualUpdate = True
            pt.ChangePivotCache sharedPivotCache
            pt.ManualUpdate = False
        Next pt
    Next ws
    
    ' 统一刷新一次缓存即可，不需要逐个刷新透视表
    sharedPivotCache.Refresh
    
    MsgBox "所有透视表数据源已更新并刷新完成"
    
    ' 恢复原有配置
    Application.ScreenUpdating = True
    Application.EnableAnimations = True
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.DisplayStatusBar = True
    
    Set sharedPivotCache = Nothing
End Sub

额外优化提示： #

• 固定写死R800000会读取大量无效空行，可以先读取远程xlsb的实际使用行数替换固定值，进一步减少读取数据量
• 循环处理时可以排除不需要修改数据源的工作表/透视表，减少处理量

该方案不需要依赖VBA即可实现自动更新，且针对大数据量的处理效率远高于传统透视表：

• 所有透视表共用同一个Power Pivot数据模型，仅需拉取1次远程数据源即可同步所有透视表
• Power Pivot自带列存储压缩，80万行42列的数据加载后仅占几十MB内存，刷新速度极快
• 可实现动态数据源路径自动匹配，不需要每月修改代码里的路径拼接逻辑
  操作步骤：
• 打开「数据」选项卡-「获取数据」-「从文件」-「从工作簿」，选择SharePoint上的月度xlsb文件
• 在Power Query编辑器中删除不需要的列、过滤空行，仅保留分析需要用到的字段
• 点击「关闭并上载至」，选择「仅创建连接」并勾选「将此数据添加到数据模型」
• 将现有所有透视表的数据源修改为「此工作簿的数据模型」
• 后续需要更新时，仅需点击「数据」选项卡-「全部刷新」即可一键同步所有透视表，不需要修改任何配置
• 如果需要自动匹配月度文件路径，可以在Power Query中添加动态日期参数，自动拼接当月的文件地址，完全不需要手动调整路径

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