对于数据透视表中显示的数据,我选择对数据表的某些部分应用条件格式以突出显示某些范围内的值。弄清楚如何以不同于小计数据的方式突出显示第二级行数据很有趣,但我能够解决它。我的 VBA 使用以下命令触发Worksheet_PivotTableUpdate
事件,以便每当用户更改数据透视表字段时,条件格式都会相应更新。
当某些部分折叠时,此方法仍然有效:
当所有顶级部分都折叠时,会发生运行时错误,因此不会显示第二级行数据(位置=2)。
我收到以下错误:
我一直在寻找一种方法来检测所有第二个位置行字段是否已折叠/隐藏/不可见/未钻孔,以便识别该条件并跳过格式化部分。但是,我还没有发现 a 的哪种方法或属性PivotField
, PivotItem
, or PivotTable
会给我这些信息。
直接附加到工作表的事件代码是
Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
ColorizeData
End Sub
所以在一个单独的模块中,代码为ColorizeData
is
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
EDIT:感谢@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