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

对于数据透视表中显示的数据，我select将条件格式应用于数据表的某些部分，以突出显示特定范围内的值。 弄清楚如何突出第二级行数据与小计数据不同，这是很有趣的，但是我能够解决这个问题。 我的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 

表的具体设置是当用户select行数据为

以防万一你想知道，为了完整起见，我在这里包含了两个私人子电话：

 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，我把他的支票与下面的逻辑合并到一个解决scheme

  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方法。 我将其封装到一个函数中，使其更清晰地集成到代码中。 所有，因为你必须testing每个领域的项目。

testing代码：

 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 

或者，如果您可能随时有dynamic项目列表，请使用以下命令：

 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