vba更新枢轴项

Question

我有一个报告，通过和改变各种枢轴字段，并将一些数据复制到另一个工作表。我为它做了一个宏，但是它实际上只是记录了我的点击的结果。我想写一个子，我可以传递一个枢轴表，枢轴字段和一个枢轴项目的名称，并让它更新字段的方式，而不是复制和粘贴的行动一遍又一遍。这是其中的一个部分，它在枢轴表中设置了三个过滤器。

`Worksheets("Closed Pivot").Activate
With ActiveSheet.PivotTables("PivotTable5").PivotFields("Business")
        .PivotItems("NEW").Visible = True
        .PivotItems("Pre-Paid Maint").Visible = False
        .PivotItems("Renewal").Visible = False
        .PivotItems("Training / Pro Svc").Visible = False
        .PivotItems("Upsell/Cross-sell").Visible = False
        .PivotItems("(blank)").Visible = False
        .PivotItems("#N/A").Visible = False
    End With
            ActiveSheet.PivotTables("PivotTable5").PivotFields("Stage"). _
        EnableMultiplePageItems = True
    With ActiveSheet.PivotTables("PivotTable5").PivotFields("Revenue Channel")
        .PivotItems("2-Tier Distributor").Visible = True
        .PivotItems("Direct Sales").Visible = True
        .PivotItems("Direct VAR").Visible = True
        .PivotItems("Ecommerce").Visible = True
        .PivotItems("Maintenance Renewal").Visible = True
        .PivotItems("(blank)").Visible = True
    End With

    With ActiveSheet.PivotTables("PivotTable5").PivotFields("Stage")
        .PivotItems("Closed Lost").Visible = False
        .PivotItems("Closed Won").Visible = True
        .PivotItems("(blank)").Visible = False
    End With`

Answer 1

有两个选项:要么将枢轴、字段和项的名称作为字符串传递给子对象，要么传递对象本身。将名称作为字符串传递时：

Sub FilterPivotByNames(wsStr as string, ptStr as string, pfStr as string, piStr as string)
Dim ws as Worksheet 
Dim pt as PivotTable
Dim pf as PivotField
Dim pi as PivotItem

Set ws = Worksheets(wsStr)
Set pt = ws.PivotTables(ptStr)
Set pf = pt.PivotFields(pfStr)

With pf
    For each pi in pf.PivotItems
        If pi.name = piStr Then
             pi.Visible = True
        Else
             pi.Visible = False
        End If
    Next pi
End With

End Sub

用法：

Sub test()
FilterPivotByNames "Sheet1", "PivotTable5", "Stage", "Closed Won" 'Just send the names as parameters; the FilterPivotByNames routine knows how to find the appropriate object.
End Sub

当传递对象本身时：

Sub FilterPivotByObject(pt as PivotTable, pf as PivotField, pi as PivotItem)
Dim pItem as PivotItem
For each pItem in pt.pf.PivotItems
    If pItem = pi then 
        pItem.visible = True
    Else
        pItem.visible = False
    End If
End Sub

用法：

Sub test2()
Dim pt as PivotTable
Dim pf as PivotField
Dim pi as PivotItem
Set pt = Worksheets("Sheet1").PivotTables("PivotTable5")
Set pf = pt.PivotFields("Stage")
Set pi = pf.PivotItem("Closed Won")
FilterPivotByObject(pt, pf, pi) 'In this scenario we first make sure we have the pivottables in variables and use those as the parameters, instead of just the names.
End Sub

您可能希望对多值筛选器等进行扩展。此外，根据谁将使用subs，也可能需要进行一些错误处理。意外值将导致错误(例如，当PivotTable5 on Worksheet1不存在时)