Excel数据透视表宏：如何让筛选器垂直堆叠而非水平排列

我编写了一个用于创建数据透视表的VBA宏，录制该宏时数据透视表的所有筛选器均为垂直堆叠状态（图1），但运行宏时筛选器却呈水平排列，无法实现垂直堆叠效果（图2）。需要修改宏，使其运行后筛选器能保持垂直堆叠状态。

原宏代码 #

'
' oepivot Macro
'
'
    Application.CutCopyMode = False
    Application.CutCopyMode = False
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "Sheet1!R1C1:R218205C31", Version:=8).CreatePivotTable TableDestination:= _
        "CrossCheck!R1C1", TableName:="PivotTable9", DefaultVersion:=8
    Sheets("CrossCheck").Select
    Cells(1, 1).Select
    With ActiveSheet.PivotTables("PivotTable9")
        .ColumnGrand = True
        .HasAutoFormat = True
        .DisplayErrorString = False
        .DisplayNullString = True
        .EnableDrilldown = True
        .ErrorString = ""
        .MergeLabels = False
        .NullString = ""
        .PageFieldOrder = 2
        .PageFieldWrapCount = 0
        .PreserveFormatting = True
        .RowGrand = True
        .SaveData = True
        .PrintTitles = False
        .RepeatItemsOnEachPrintedPage = True
        .TotalsAnnotation = False
        .CompactRowIndent = 1
        .InGridDropZones = False
        .DisplayFieldCaptions = True
        .DisplayMemberPropertyTooltips = False
        .DisplayContextTooltips = True
        .ShowDrillIndicators = True
        .PrintDrillIndicators = False
        .AllowMultipleFilters = False
        .SortUsingCustomLists = True
        .FieldListSortAscending = False
        .ShowValuesRow = False
        .CalculatedMembersInFilters = False
        .RowAxisLayout xlCompactRow
    End With
    With ActiveSheet.PivotTables("PivotTable9").PivotCache
        .RefreshOnFileOpen = False
        .MissingItemsLimit = xlMissingItemsDefault
    End With
    ActiveSheet.PivotTables("PivotTable9").RepeatAllLabels xlRepeatLabels
    With ActiveSheet.PivotTables("PivotTable9").PivotFields("Accounting Period")
        .Orientation = xlPageField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("PivotTable9").PivotFields("Object")
        .Orientation = xlPageField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("PivotTable9").PivotFields("Object Class")
        .Orientation = xlPageField
        .Position = 2
    End With
    Application.Width = 886.5
    Application.Height = 661.5
    With ActiveSheet.PivotTables("PivotTable9").PivotFields("Fiscal Year")
        .Orientation = xlPageField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("PivotTable9").PivotFields("PE FILTER")
        .Orientation = xlRowField
        .Position = 1
    End With
    ActiveSheet.PivotTables("PivotTable9").AddDataField ActiveSheet.PivotTables( _
        "PivotTable9").PivotFields("Jrnl Posting Code"), "Count of Jrnl Posting Code", _
        xlCount
End Sub

解决方案 #

问题根源在于透视表的两个关键属性设置：

• PageFieldWrapCount：原代码中设为0，这会让筛选器水平排列，填满一行后才换行。要实现垂直堆叠，需将其改为1，让每个筛选器单独占据一行。
• PageFieldOrder：保持原代码中的2（对应常量xlOverThenDown），该属性控制筛选器优先垂直排列，配合PageFieldWrapCount=1就能实现完全垂直堆叠的效果。

修改后的宏代码 #

'
' oepivot Macro
'
'
    Application.CutCopyMode = False
    Application.CutCopyMode = False
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "Sheet1!R1C1:R218205C31", Version:=8).CreatePivotTable TableDestination:= _
        "CrossCheck!R1C1", TableName:="PivotTable9", DefaultVersion:=8
    Sheets("CrossCheck").Select
    Cells(1, 1).Select
    With ActiveSheet.PivotTables("PivotTable9")
        .ColumnGrand = True
        .HasAutoFormat = True
        .DisplayErrorString = False
        .DisplayNullString = True
        .EnableDrilldown = True
        .ErrorString = ""
        .MergeLabels = False
        .NullString = ""
        .PageFieldOrder = 2 ' 保持垂直优先排列
        .PageFieldWrapCount = 1 ' 设置为1，每个筛选器单独一行
        .PreserveFormatting = True
        .RowGrand = True
        .SaveData = True
        .PrintTitles = False
        .RepeatItemsOnEachPrintedPage = True
        .TotalsAnnotation = False
        .CompactRowIndent = 1
        .InGridDropZones = False
        .DisplayFieldCaptions = True
        .DisplayMemberPropertyTooltips = False
        .DisplayContextTooltips = True
        .ShowDrillIndicators = True
        .PrintDrillIndicators = False
        .AllowMultipleFilters = False
        .SortUsingCustomLists = True
        .FieldListSortAscending = False
        .ShowValuesRow = False
        .CalculatedMembersInFilters = False
        .RowAxisLayout xlCompactRow
    End With
    With ActiveSheet.PivotTables("PivotTable9").PivotCache
        .RefreshOnFileOpen = False
        .MissingItemsLimit = xlMissingItemsDefault
    End With
    ActiveSheet.PivotTables("PivotTable9").RepeatAllLabels xlRepeatLabels
    With ActiveSheet.PivotTables("PivotTable9").PivotFields("Accounting Period")
        .Orientation = xlPageField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("PivotTable9").PivotFields("Object")
        .Orientation = xlPageField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("PivotTable9").PivotFields("Object Class")
        .Orientation = xlPageField
        .Position = 2
    End With
    Application.Width = 886.5
    Application.Height = 661.5
    With ActiveSheet.PivotTables("PivotTable9").PivotFields("Fiscal Year")
        .Orientation = xlPageField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("PivotTable9").PivotFields("PE FILTER")
        .Orientation = xlRowField
        .Position = 1
    End With
    ActiveSheet.PivotTables("PivotTable9").AddDataField ActiveSheet.PivotTables( _
        "PivotTable9").PivotFields("Jrnl Posting Code"), "Count of Jrnl Posting Code", _
        xlCount
End Sub

效果对比 #

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