Excel VBA：如何阻止数据透视表更改筛选后自动重排

要实现筛选后保持数据透视表行的初始排序，不能直接设置xlManual（会清空已有的排序），需要先保存初始排序结果，再在每次透视表更新时恢复该顺序，具体步骤如下：

1. 初始化排序并保存顺序 #

在标准模块中添加以下代码，运行一次完成初始排序并保存排序后的字段项顺序：

Sub SetPivotInitialSort()
    Dim pt As PivotTable
    Dim pf As PivotField
    Dim sortedItems As Variant
    Dim i As Integer
    
    ' 替换为你的工作表和数据透视表名称
    Set pt = ThisWorkbook.Worksheets("Sheet1").PivotTables("PivotTable1")
    Set pf = pt.PivotFields("Category")
    
    ' 执行初始降序排序
    pf.AutoSort xlDescending, "Count of Category"
    
    ' 保存排序后的字段项名称到数组
    ReDim sortedItems(1 To pf.PivotItems.Count)
    For i = 1 To pf.PivotItems.Count
        sortedItems(i) = pf.PivotItems(i).Name
    Next i
    
    ' 将排序结果存入工作表自定义属性（避免丢失）
    pt.Parent.CustomProperties.Add Name:="PivotCategorySort", Value:=Join(sortedItems, "|")
    
    ' 禁用自动排序（此时会打乱顺序，后续立即恢复）
    pf.AutoSort xlManual, "Count of Category"
    
    ' 恢复初始排序
    RestorePivotSort pt, pf
End Sub

2. 添加透视表更新事件 #

右键点击数据透视表所在的工作表标签 → 选择「查看代码」，在工作表代码模块中添加以下代码，用于筛选变更后自动恢复排序：

Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
    Dim pf As PivotField
    
    ' 仅处理目标数据透视表
    If Target.Name = "PivotTable1" Then
        Set pf = Target.PivotFields("Category")
        RestorePivotSort Target, pf
    End If
End Sub

' 通用恢复排序的子过程
Private Sub RestorePivotSort(pt As PivotTable, pf As PivotField)
    Dim sortedItems As Variant
    Dim itemName As Variant
    Dim i As Integer
    
    ' 读取保存的排序顺序
    sortedItems = Split(pt.Parent.CustomProperties("PivotCategorySort"), "|")
    
    ' 确保处于手动排序模式
    pf.AutoSort xlManual, "Count of Category"
    
    ' 按初始排序顺序重新排列可见项
    For i = UBound(sortedItems) To LBound(sortedItems) Step -1
        itemName = sortedItems(i)
        ' 只处理当前可见的字段项（筛选后部分项会隐藏）
        If pf.PivotItems(itemName).Visible Then
            pf.PivotItems(itemName).Position = i
        End If
    Next i
End Sub

注意事项 #

• 替换代码中的Sheet1为你的实际工作表名称。
• 如果Category字段存在名称含|的项，将代码中的分隔符|替换为其他不冲突的字符（如^）。
• 确保Category字段的项名称唯一，否则排序恢复会出错。

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