如何用VBA折叠只有一个子项目的枢轴项目？

Question

我有一个具有多个大纲级别的数据源。这是一个例子：

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

类的合适属性，可以将其用于关于何时应该或不应该折叠它们的条件。

Answer 1

我会以编程方式执行此操作，就像我手动执行此操作一样。

首先查看第 1 层。浏览数据透视表行范围中的所有行。如果有一个 1 级条目，则后面只有一个 2 级条目，然后只有一个 3 级条目。因此，3 行之后的条目再次是级别 1 或数据透视表行范围的末尾，然后不显示该级别 1 条目的详细信息。

2 级也是如此。如果有 2 级条目，则后面只有一个 3 级条目。因此，后面 2 行的条目又是级别 2 或级别 1 或数据透视表行范围的末尾，然后不显示该级别 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

Answer 2

解决方案是检查数据透视项数据范围行数

Dim lo_pf As Excel.PivotField, lo_pi As Excel.PivotItem
With activesheet.pivottables(1).pvt
        For Each lo_pf In .PivotFields
            If lo_pf.Orientation = Excel.XlPivotFieldOrientation.xlRowField Then
                For Each lo_pi In lo_pf.PivotItems
                    If lo_pi.DataRange.rows.count = 1 Then lo_pi.ShowDetail = False
                Next lo_pi
            End If
        Next lo_pf
    End With

Answer 3

这个怎么样？

    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