数据透视表：当数据透视字段折叠时检测

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

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