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级入口，然后只有1级3入口。因此，后面的3行再次是Level 1或者是Pivot Table的行范围的结尾，然后不显示该Level 1条目的详细信息。

然后对于第2级相同。如果存在第2级条目，则只有一个第3级条目。因此，后面的2行再次是Level 2或Level 1或者Pivot Table的行范围的结尾，然后不显示该Level 2条目的详细信息。

一般来说，对于n个级别：如果有一个级别k条目后面只有一个级别（k + 1）条目，然后只有一个级别（k + 2）条目，那么只有一个级别（k + 3）输入...然后只有一个Level（n）条目。所以后面的条目（n-k + 1））再次是k级或级别（k-1）或级别（k-2）...或级别（1）或者数据透视表的结尾行范围，然后不显示该级别k条目的详细信息。

但是，如果一个Level k条目一次有多个Level（k + 1）条目，那么另一个时间它只有一个Level（k + 1）条目怎么办？然后它也应该显示细节，因为它有一次超过一个Level（k + 1）条目。

因此，我将在字典中收集Level条目以及是否显示详细信息的决定。然后我通过那本字典来实施决定。

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

怎么回事？

    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

如何折叠只有一个VBA子项的透视项目？

2 个答案: