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

有两个选项：您可以将pivottables的名称，字段和项目作为字符串传递给sub，或者传递对象本身。将名称作为字符串传递时：

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

您可能希望扩展这些用于多值过滤器等。此外，一些错误处理可能是有序的，具体取决于谁将使用sub。意外的值将导致错误（例如，当Worksheet1上的PivotTable5不存在时）

vba更新数据透视项目

1 个答案: