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

对于数据透视表中显示的数据，我选择将条件格式应用于数据表的某些部分，以突出显示某些范围内的值 . 有趣的是弄清楚如何突出显示第二级行数据与小计数据不同，但我能够解决它 . 我的VBA使用 Worksheet_PivotTableUpdate 事件触发，以便每当用户更改数据透视表字段时，条件格式都会相应更新 .

折叠某些部分时，此方法继续有效：

折叠所有顶级部分时发生运行时错误，因此不显示第二级行数据（位置= 2） .

我收到以下错误：

我've been looking for a way to detect if ALL of the second position row fields are collapsed/hidden/invisible/not-drilledTo in order to identify that condition and skip the formatting part. However, I'未发现 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