修改数据透视表缓存的VBA代码无法运行，求技术支持

你的核心需求是将筛选后的透视表结果作为新数据源替换原透视表缓存，避免他人看到未筛选数据。现有代码存在几个关键问题，导致无法正常运行：

主要问题分析 #

1. 数据源格式错误：用pt.DataBodyRange作为xlDatabase类型的数据源是错误的——xlDatabase要求数据源包含表头的连续区域，而DataBodyRange仅指透视表的数值区域（无表头），无法被识别为有效数据库源。
2. 字段名称引用错误：替换缓存后，新数据源是透视表的结果区域，字段名不再是原透视表的"Row Labels"或"Count of Option Name3"，直接引用这些旧名称会导致找不到字段报错。
3. 对象引用冗余且易出错：反复通过ActiveSheet.PivotTables(pt.Name)调用透视表，不如直接使用已定义的pt对象，既高效又避免名称变更带来的引用问题。

修正后的代码 #

Dim ws As Worksheet
Dim pt As PivotTable
Dim staticRng As Range
Dim newCache As PivotCache

' 初始化对象
Set ws = ActiveSheet
If ws.PivotTables.Count < 1 Then Exit Sub
Set pt = ws.PivotTables(1)

' 1. 将筛选后的透视表结果复制为静态数据（放在透视表下方的空白区域）
pt.TableRange1.Copy
Set staticRng = ws.Cells(pt.TableRange1.Row + pt.TableRange1.Rows.Count + 2, 1)
staticRng.PasteSpecial xlPasteValuesAndNumberFormats
Application.CutCopyMode = False

' 2. 基于静态数据创建新缓存
Set newCache = ActiveWorkbook.PivotCaches.Create( _
    SourceType:=xlDatabase, _
    SourceData:=staticRng.CurrentRegion, _
    Version:=xlPivotTableVersion15)

' 3. 替换原透视表缓存
pt.ChangePivotCache newCache

' 4. 重新设置透视表字段（注意使用新数据源的实际列名）
With pt
    ' 清除原有字段布局
    .ClearAllFilters
    For Each pf In .PivotFields
        pf.Orientation = xlHidden
    Next pf
    
    ' 设置行字段（静态数据第一列为行标签列，可根据实际调整）
    .PivotFields(staticRng.Value).Orientation = xlRowField
    .PivotFields(staticRng.Value).Position = 1
    
    ' 设置数据字段（静态数据第二列为数值列，可根据实际调整）
    .AddDataField .PivotFields(staticRng.Offset(0, 1).Value), _
        "Sum of Value", xlSum
    ' 添加百分比字段
    .AddDataField .PivotFields(staticRng.Offset(0, 1).Value), _
        "Percent of Column", xlSum
    .PivotFields("Percent of Column").Calculation = xlPercentOfColumn
    
    ' 隐藏空白项
    .PivotFields(staticRng.Value).PivotItems("(blank)").Visible = False
    
    ' 可选：删除静态数据（如果不需要保留）
    ' staticRng.CurrentRegion.Delete
End With

关键说明 #

• 先将透视表结果复制为静态数据：这一步是核心，因为透视表自身的结果区域不能直接作为数据库源，必须转换成带表头的普通单元格区域。
• 动态引用新数据源的字段名：通过staticRng.Value获取静态数据的表头，避免硬编码字段名导致的错误。
• 清除原有布局再重新设置：替换缓存后原有的字段布局会失效，必须重新配置。

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