数据透视表：检测数据透视字段是否已折叠

Question

对于我的数据显示在一个数据透视表中，我选择对某些部分应用条件格式，以突出显示特定范围内的值。有趣的是，我想出了如何将第二级行数据与小计数据区别高亮显示，但我成功地解决了这个问题。我的VBA使用Worksheet_PivotTableUpdate事件触发，因此每当用户更改数据透视表字段时，条件格式都会相应地更新。

这种方法在一些部分折叠时仍然有效：

我的运行时错误发生在所有顶级部分都折叠起来时，因此第二级行数据（位置=2）不会显示。

我得到了以下错误：

我一直在寻找一种方法来检测第二个位置行的所有字段是否已折叠/隐藏/不可见/未钻取，以便识别该条件并跳过格式化部分。然而，我还没有发现哪种方法或属性可以提供PivotField、PivotItem或PivotTable的相关信息。

附加到工作表的事件代码是：

Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
    ColorizeData
End Sub

因此，在另一个模块中，ColorizeData 的代码如下：

Option Explicit

Sub ColorizeData()
    Dim staffingTable As PivotTable
    Dim data As Range
    Set staffingTable = ActiveSheet.PivotTables(PIVOT_TABLE_NAME)
    Set data = staffingTable.DataBodyRange
    '--- don't select the bottom TOTALS row, we don't want it colored
    Set data = data.Resize(data.rows.count - 1)

    '--- ALWAYS clear all the conditional formatting before adding
    '    or changing it. otherwise you end up with lots of repeated
    '    formats and conflicting rules
    ThisWorkbook.Sheets(PIVOT_SHEET_NAME).Cells.FormatConditions.Delete
    ThisWorkbook.Sheets(PIVOT_SHEET_NAME).Cells.ClearFormats
    staffingTable.DataBodyRange.Cells.NumberFormat = "#0.00"
    staffingTable.ColumnRange.NumberFormat = "mmm-yyyy"

    '--- the cell linked to the checkbox on the pivot sheet is
    '    supposed to be covered (and hidden) by the checkbox itself
    If Not ThisWorkbook.Sheets(PIVOT_SHEET_NAME).Range("D2") Then
        '--- we've already cleared it, so we're done
        Exit Sub
    End If

    '--- capture the active cell so we can re-select it after we're done
    Dim previouslySelected As Range
    Set previouslySelected = ActiveCell

    '--- colorizing will be based on the type of data being shown.
    '    Many times there will be multiple data sets shown as sums in
    '    the data area. the conditional formatting by FTEs only makes
    '    sense if we colorize the Resource or TaskName fields
    '    most of the other fields will be shown as summary lines
    '    (subtotals) so those will just get a simple and consistent
    '    color scheme

    Dim field As PivotField
    For Each field In staffingTable.PivotFields
        Select Case field.Caption
        Case "Project"
            If field.Orientation = xlRowField Then
                If field.Position = 1 Then
                    staffingTable.PivotSelect field.Caption, xlFirstRow, True
                    ColorizeDataRange Selection, RGB(47, 117, 181), RGB(255, 255, 255)
                End If
            End If
        Case "WorkCenter"
            If field.Orientation = xlRowField Then
                If field.Position = 1 Then
                    staffingTable.PivotSelect field.Caption, xlFirstRow, True
                    ColorizeDataRange Selection, RGB(155, 194, 230), RGB(0, 0, 0)
                End If
            End If
        Case "Resource"
            If field.Orientation = xlRowField Then
                If field.Position = 1 Then
                    staffingTable.PivotSelect field.Caption, xlFirstRow, True
                Else
===> ERROR HERE-->  staffingTable.PivotSelect field.Caption, xlDataOnly, True
                End If
                ColorizeConditionally Selection
            End If
        Case "TaskName"
            If field.Orientation = xlRowField Then
                If field.Position = 1 Then
                    staffingTable.PivotSelect field.Caption, xlFirstRow, True
                Else
                    staffingTable.PivotSelect field.Caption, xlDataOnly, True
                End If
                ColorizeConditionally Selection
            End If
        End Select
    Next field

    '--- re-select the original cell so it looks the same as before
    previouslySelected.Select
End Sub

特定的表格设置是当用户选择行数据时。

如果你在想，我在这里加入了这两个私有子调用，以完整起见：

Private Sub ColorizeDataRange(ByRef data As Range, _
                              ByRef interiorColor As Variant, _
                              ByRef fontColor As Variant)
    data.interior.Color = interiorColor
    data.Font.Color = fontColor
End Sub

Private Sub ColorizeConditionally(ByRef data As Range)
    '--- light green for part time FTEs
    Dim dataCondition As FormatCondition
    Set dataCondition = data.FormatConditions.Add(Type:=xlCellValue, _
                                                  Operator:=xlBetween, _
                                                  Formula1:="=0.1", _
                                                  Formula2:="=0.5")
    With dataCondition
        .Font.ThemeColor = xlThemeColorLight1
        .Font.TintAndShade = 0
        .interior.PatternColorIndex = xlAutomatic
        .interior.ThemeColor = xlThemeColorAccent6
        .interior.TintAndShade = 0.799981688894314
        .SetFirstPriority
        .StopIfTrue = False
    End With

    '--- solid green for full time FTEs
    Set dataCondition = data.FormatConditions.Add(Type:=xlCellValue, _
                                                  Operator:=xlBetween, _
                                                  Formula1:="=0.51", _
                                                  Formula2:="=1.2")
    With dataCondition
        .Font.ThemeColor = xlThemeColorLight1
        .Font.TintAndShade = 0
        .Font.Color = RGB(0, 0, 0)
        .interior.PatternColorIndex = xlAutomatic
        .interior.Color = 5296274
        .SetFirstPriority
        .StopIfTrue = False
    End With

    '--- orange for slightly over full time FTEs
    Set dataCondition = data.FormatConditions.Add(Type:=xlCellValue, _
                                                  Operator:=xlBetween, _
                                                  Formula1:="=1.2", _
                                                  Formula2:="=1.85")
    With dataCondition
        .Font.Color = RGB(0, 0, 0)
        .Font.TintAndShade = 0
        .interior.PatternColorIndex = xlAutomatic
        .interior.Color = RGB(255, 192, 0)
        .SetFirstPriority
        .StopIfTrue = False
    End With

    '--- red for way over full time FTEs
    Set dataCondition = data.FormatConditions.Add(Type:=xlCellValue, _
                                                  Operator:=xlGreater, _
                                                  Formula1:="=1.85")
    With dataCondition
        .Font.Color = RGB(255, 255, 255)
        .Font.TintAndShade = 0
        .interior.PatternColorIndex = xlAutomatic
        .interior.Color = RGB(255, 0, 0)
        .SetFirstPriority
        .StopIfTrue = False
    End With
End Sub

编辑：感谢@ScottHoltzman的帮助，我将他的检查逻辑与下面的逻辑结合起来，得出了解决方案。

    Case "Resource"
        If field.Orientation = xlRowField Then
            If (field.Position = 2) And PivotItemsShown(staffingTable.PivotFields("Project")) Then
                staffingTable.PivotSelect field.Caption, xlDataOnly, True
                ColorizeConditionally Selection
            ElseIf field.Position = 1 Then
                staffingTable.PivotSelect field.Caption, xlFirstRow, True
                ColorizeConditionally Selection
            End If
        End If

- PeterT

Answer 1

使用PivotItems对象的ShowDetail方法。我对其进行了封装，以便更清晰地集成到您的代码中。这是因为您必须测试字段的每个项。

测试代码：

If field.Orientation = xlRowField Then
    If PivotItemsShown(field) Then
        If field.Position = 1 Then
            staffingTable.PivotSelect field.Caption, xlFirstRow, True
        Else
            staffingTable.PivotSelect field.Caption, xlDataOnly, True
        End If
        ColorizeConditionally Selection
    End If
End If

Function PivotItemShown(pf as PivotField) as Boolean

    Dim pi as PivotItem

    For each pi in pf.PivotItems
        If pi.ShowDetail Then 
            PivotItemsShown = True
            Exit For
        End If
    Next

End Function

更新：下面有两种方法可以解决问题

由于您知道，在您的示例中，如果所有3个项目都被折叠，单元格A10将为空，因此您可以这样检查：

If Len(Range("A10") Then ... `skip this section

或者，如果您可能随时具有动态项目列表，请使用此选项：

For each rng in Range(Range("A6"),Range("A6").End(xlDown))
    If Instr(rng.Value,"Project") = 0 and rng.Value <> "Grand Total" Then 
        '.... select the row range as needed
        Exit For
    End If
Next 

- Scott Holtzman

---

有趣的方法，但行不通。奇怪的是，即使所有的二级行都折叠起来，"资源"字段pi.ShowDetail仍然为true。 - PeterT

@PeterT，问题不在于ShowDetail而在于PivotItems。它返回与字段无关的项目。即使尝试了官方示例，我也无法理解返回值。我猜这个方法是有问题的。 - Florent B.

@PeterT - 好的，我明白你说的第二个级别会返回true（有点奇怪）。但是，仍然可以通过传递Project字段来使用该函数。传递 staffingTable.PivotFields("Project")（或者实际名称），并查看是否有效。如果第一个级别没有可见项，那么你知道所有内容都折叠在高级别处。 - Scott Holtzman

我最初也想到了这些可能有用的黑客方法。我现在正在编辑答案。 - Scott Holtzman

这是一个棘手的问题。已更新解决方案如上所示。谢谢！ - PeterT

@PeterT - 很难。是的。我一直觉得像这样的情况和其他情况下，数据透视表代码逻辑非常不足。似乎与其他Excel对象相符合的直觉和内联内容在数据透视表对象中似乎缺失。或者也许我从未深入挖掘过为什么会这样。 - Scott Holtzman