Excel VBA循环遍历枢轴项和枢轴字段的交叉点

I am trying to write a code that can apply conditional formatting to each intersection of two pivot fields separately. For example, I would like to select all entries for PartNumber 541-9037-100 in the "Average of TransA1" column, apply conditional formatting, then proceed to PartNumber, select all entries in the "Average of TransA1" column, apply conditional formatting, etc.

我正在尝试编写一个代码,可以将条件格式分别应用于两个透视字段的每个交集。例如,我想在“TransA1平均值”列中选择PartNumber 541-9037-100的所有条目,应用条件格式,然后继续到PartNumber,选择“TransA1平均值”列中的所有条目,应用条件格式等

PartNumbers will vary from week to week, so I am looking for a generic code that will loop through every item in the PartNumber field.

PartNumbers会因周而异,所以我正在寻找一个通用代码,它将遍历PartNumber字段中的每个项目。

I have tried to use a for loop, but seem to be selecting the entire Average of TransA1 column at once rather than the intersection of the Average of TransA1 column and each PartNumber item. A copy of my code is below- Can anyone help me revise my code to select only the intersections of the fields?

我试图使用for循环,但似乎是一次选择整个TransA1平均值列,而不是TransA1平均值列和每个PartNumber项的交集。我的代码副本如下 - 任何人都可以帮我修改我的代码,只选择字段的交叉点吗?

ConditionalFormatting2 Macro

'
' Select intersect of pivot table and output cell values to apply formatting
Dim pt As PivotTable

Set pt = Worksheets("Pivot Sheet").PivotTables("PivotTable2")

For Each PivotItem In pt.PivotFields("PartNumber").PivotItems
'Select the "Average of TransA1" column and apply conditional formatting
    Application.PivotTableSelection = True
    pt.PivotSelect "Average of TransA1", xlDataOnly
  With Selection.Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .ThemeColor = xlThemeColorAccent6
    .TintAndShade = 0.399975585192419
    .PatternTintAndShade = 0
  End With
  Selection.FormatConditions.AddTop10
  Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
  With Selection.FormatConditions(1)
    .TopBottom = xlTop10Top
    .Rank = 30
    .Percent = True
  End With
  With Selection.FormatConditions(1).Interior
    .PatternColorIndex = xlAutomatic
    .ThemeColor = xlThemeColorAccent4
    .TintAndShade = 0.399945066682943
  End With
  Selection.FormatConditions(1).StopIfTrue = False
  Selection.FormatConditions.AddTop10
  Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
  With Selection.FormatConditions(1)
    .TopBottom = xlTop10Top
    .Rank = 10
    .Percent = True
  End With
  With Selection.FormatConditions(1).Interior
    .PatternColorIndex = xlAutomatic
    .Color = 8420607
    .TintAndShade = 0
  End With
  Selection.FormatConditions(1).StopIfTrue = False
  Selection.FormatConditions.AddTop10
  Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
  With Selection.FormatConditions(1)
    .TopBottom = xlTop10Bottom
    .Rank = 30
    .Percent = True
  End With
  With Selection.FormatConditions(1).Interior
    .PatternColorIndex = xlAutomatic
    .ThemeColor = xlThemeColorAccent4
    .TintAndShade = 0.399945066682943
  End With
  Selection.FormatConditions(1).StopIfTrue = False
  Selection.FormatConditions.AddTop10
  Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
  With Selection.FormatConditions(1)
    .TopBottom = xlTop10Bottom
    .Rank = 10
    .Percent = True
  End With
  With Selection.FormatConditions(1).Interior
    .PatternColorIndex = xlAutomatic
    .Color = 8420607
    .TintAndShade = 0
  End With
  Selection.FormatConditions(1).StopIfTrue = False
Next PivotItem

'
End Sub

strong text

1 个解决方案

#1

Figured it out- it isn't pretty, but it works

想出来它 - 它不漂亮,但它的工作原理

'declare variables
Dim pt As PivotTable
Dim rng1 As Range
Dim rng2 As Range
Dim pn As String
Dim rw As Integer
Dim cntpi As Long

'Sets current worksheet, initializes rw and cntpi
Set pt = Worksheets("Pivot Sheet").PivotTables("PivotTable2")
rw = 5
cntpi = 0

'sets rng1 as the Average of TransA1 column
Range("A5").Select
Set rng1 = pt.PivotFields("Average of TransA1").DataRange.EntireColumn

'Loops through each part number, applies conditional formatting to all part number groups in data area
For Each PivotItem In pt.PivotFields("PartNumber").PivotItems
    rw = rw + cntpi
    Range(Cells(rw, 1), Cells(rw, 1)).Select
    pn = Trim(ActiveCell.Value)
    Set rng2 = pt.PivotFields("PartNumber").PivotItems(pn).DataRange.EntireRow
    Intersect(rng1, rng2).Select
    cntpi = Selection.Rows.Count

    Selection.FormatConditions.AddColorScale ColorScaleType:=3
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    Selection.FormatConditions(1).ColorScaleCriteria(1).Type = _
        xlConditionValueLowestValue
    With Selection.FormatConditions(1).ColorScaleCriteria(1).FormatColor
        .Color = 6737151
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).ColorScaleCriteria(2).Type = _
        xlConditionValuePercentile
    Selection.FormatConditions(1).ColorScaleCriteria(2).Value = 50
    With Selection.FormatConditions(1).ColorScaleCriteria(2).FormatColor
        .Color = 6736896
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).ColorScaleCriteria(3).Type = _
        xlConditionValueHighestValue
    With Selection.FormatConditions(1).ColorScaleCriteria(3).FormatColor
        .Color = 6737151
        .TintAndShade = 0
    End With


Next PivotItem