代码之家 › 专栏 › 技术社区 › Greg Viers Russ Ebbing

如何使用VBA折叠只有一个子项的数据透视项?

vba pivot-table excel

Greg Viers Russ Ebbing · 技术社区 · 7 年前

我有一个具有多个大纲级别的数据源。以下是一个示例:

Level 1 | Level 2 | Level 3
A        1          X1
A        1          X2
A        2          X3
B        3          X4
B        4          X5
B        4          X5
C        5          X6
C        5          X6
C        5          X6

当我旋转它时,所有3个字段都是行标签,如下所示:

我想要的是折叠下面只有一个项目的项目。我可以很容易地手动完成,结果如下:

我知道如何通过 pivot tables 和 pivot fields 。例如,我可以使用以下代码将其全部折叠:

Sub CollapseAllPivotItems()

    With ActiveSheet.PivotTables(1)
        For Each pf In .PivotFields
            If pf.Orientation = xlRowField Then
                For Each Pi In pf.PivotItems
                    ' Need the IF condition to go here
                       Pi.ShowDetail = False
                Next Pi
            End If
        Next pf
    End With
End Sub

但我找不到 PivotItem 类,我可以使用该类作为条件,以确定何时应该或不应该折叠它们。

2 回复 | 直到 6 年前

Axel Richter 6 年前

我会用编程的方式来做,就像我手动做一样。

首先看一下级别1。遍历透视表行范围中的所有行。如果有一个1级条目之后只有一个2级条目,然后只有一个3级条目。因此,后面3行的条目再次是级别1或透视表行范围的末尾,然后不显示该级别1条目的详细信息。

第2级也一样。如果有一个2级条目,后面只有一个3级条目。因此,后面的条目2行再次是Level 2或Level 1或透视表行范围的末尾,然后不显示该Level 2条目的详细信息。

一般来说,对于n个级别:如果有一个k级条目,后面只有一个k+1级条目,然后只有一个k+2级条目,然后只有一个k+3级条目。。。然后只有一个级别(n)条目。因此,后面的条目(n-k+1)行再次是级别k或级别(k-1)或级别(k-2)。。。或级别(1)或数据透视表行范围的末尾,则不显示该级别k条目的详细信息。

但是,如果一个k级条目一次有多个k+1级条目,但另一次只有一个k+1级条目,该怎么办?然后,它还应该显示详细信息,因为它有一次多个级别(k+1)条目。

因此,我将在字典中收集级别条目,以及是否显示详细信息的决定。然后我翻阅字典来执行决策。

Option Explicit

Sub hideDetailPivotItems()
 Dim oPT As PivotTable
 Dim oPF As PivotField, oPFSibling As PivotField
 Dim oPRow  As Range, oPRowSibling As Range
 Dim oPI As PivotItem
 Dim sPIName As Variant
 Dim i As Long, k As Long, s As Long, lCountRowPFs As Long
 Dim bShowDetail  As Boolean
 Dim dPIShowDetail As Object

 Set oPT = ActiveSheet.PivotTables("PivotTable1")

 Dim aRowPFs() As String

 i = 0
 For Each oPF In oPT.RowFields
  ReDim Preserve aRowPFs(i)
  aRowPFs(i) = oPF.Name
  i = i + 1

  On Error Resume Next
  oPF.ShowDetail = True
  On Error GoTo 0

 Next

 lCountRowPFs = UBound(aRowPFs)
 For k = 0 To lCountRowPFs - 1

  Set dPIShowDetail = CreateObject("Scripting.Dictionary")

  For i = 1 To oPT.RowRange.Count

   Set oPRow = oPT.RowRange.Item(i)

   Set oPF = Nothing
   On Error Resume Next
   Set oPF = oPRow.PivotField
   On Error GoTo 0
   If Not oPF Is Nothing Then

    If oPF.Name = aRowPFs(k) Then

     Set oPI = Nothing
     On Error Resume Next
     Set oPI = oPRow.PivotItem
     On Error GoTo 0
     If Not oPI Is Nothing Then

      Set oPRowSibling = Nothing
      Set oPFSibling = Nothing
      On Error Resume Next
      Set oPRowSibling = oPT.RowRange.Item(i + (lCountRowPFs - k + 1))
      Set oPFSibling = oPRowSibling.PivotField
      On Error GoTo 0

      bShowDetail = True
      If oPRowSibling Is Nothing Then
       bShowDetail = False
      ElseIf oPFSibling Is Nothing Then
       bShowDetail = False
      Else
       For s = k To 0 Step -1
        If oPFSibling.Name = aRowPFs(s) Then
         bShowDetail = False
        End If
       Next
      End If

      If dPIShowDetail.exists(oPI.Name) Then
       If bShowDetail Then dPIShowDetail(oPI.Name) = bShowDetail
      Else
       dPIShowDetail.Add oPI.Name, bShowDetail
      End If
     End If
    End If
   End If
  Next

  For Each sPIName In dPIShowDetail.keys
   oPT.PivotFields(aRowPFs(k)).PivotItems(sPIName).ShowDetail = dPIShowDetail(sPIName)
  Next

 Next

End Sub

-1

Jan 7 年前

这个怎么样?

    Sub CollapseAllPivotItems()
        With ActiveSheet.PivotTables(1)
            For Each pf In .PivotFields
                If pf.Orientation = xlRowField Then
                    For Each Pi In pf.PivotItems
                        If pf.PivotItems.Count = 1 Then
                               Pi.ShowDetail = False
                        End If
                    Next Pi
                End If
            Next pf
        End With
    End Sub