Excel/VBA：使用一个值列表过滤多个数据透视表答案

【问题标题】：Excel/VB: Filtering mulitple pivot tables using the one list of valuesExcel/VBA：使用一个值列表过滤多个数据透视表
【发布时间】：2017-07-06 07:46:20
【问题描述】：

我正在尝试从值的引用列表中过滤一张工作表上的多个数据透视表，但看起来它只处理第一个 With 语句 (CampaignAnalysis) 然后它返回一个错误 (MailCount)。对此的任何帮助都会很棒！谢谢！

Sub Test()
 Dim PI As PivotItem
 With Worksheets("In Focus - Campaign Analysis").PivotTables("CampaignAnalysis").PivotFields("Campaign Code")
 .ClearAllFilters
 For Each PI In .PivotItems
 PI.Visible = WorksheetFunction.CountIf(Range("CA_Range1"), PI.Name) > 0
 Next PI
 End With

 Dim MC As PivotItem
 With Worksheets("In Focus - Campaign Analysis").PivotTables("MailCount").PivotFields("MailCount_CC")
 .ClearAllFilters
 For Each MC In .PivotItems
 MC.Visible = WorksheetFunction.CountIf(Range("CA_Range1"), MC.Name) > 0
 Next MC
 End With
 End Sub

【问题讨论】：

使用此过滤器确保至少有一个 MC 可见。可能发生的情况是，当您的代码尝试隐藏列表中的最后一项时，它会遇到错误。如果不自己运行代码，这是我最好的猜测。
感谢布兰登的反馈。我设法让它工作，所以我很欣赏这种洞察力。我目前遇到的当前问题是尝试更新一个数据透视表中的两个字段。这两个字段是一个范围（有效），但第二个字段是引用回另一个计算单元格的日期
所以在这里，“Segment”中有另一个 PivotFields，称为“ReportDate”，我试图引用此工作表上的计算日期单元格，例如A1 但无法使代码正常工作。如何将第二个 PivotField 集成到代码中？
整个代码在下面 & where (****) 我想输入新代码，即“ReportDate”PivotField 是“Segment”数据透视表中的第二个过滤器

标签： excel vba filtering pivot-table

【解决方案1】：

Sub Test()

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False
Application.DisplayStatusBar = False
Application.DisplayAlerts = False

Dim PI As PivotItem
With ActiveSheet.PivotTables("CampaignAnalysis").PivotFields("Campaign  Code")
.ClearAllFilters
    For Each PI In .PivotItems
        PI.Visible = WorksheetFunction.CountIf(Range("CA_Range1"), PI.Name) > 0
    Next PI

With ActiveSheet.PivotTables("MailCount").PivotFields("Campaign Code")
.ClearAllFilters
    For Each MC In .PivotItems
        MC.Visible = WorksheetFunction.CountIf(Range("CA_Range1"), MC.Name) > 0
    Next MC

With ActiveSheet.PivotTables("AgeRange").PivotFields("Campaign Code")
.ClearAllFilters
    For Each AR In .PivotItems
        AR.Visible = WorksheetFunction.CountIf(Range("CA_Range1"), AR.Name) > 0
    Next AR

With ActiveSheet.PivotTables("DrivablePort").PivotFields("Campaign Code")
.ClearAllFilters
    For Each DP In .PivotItems
        DP.Visible = WorksheetFunction.CountIf(Range("CA_Range1"), DP.Name) > 0
    Next DP

With ActiveSheet.PivotTables("CruiseName").PivotFields("Campaign Code")
.ClearAllFilters
    For Each CN In .PivotItems
        CN.Visible = WorksheetFunction.CountIf(Range("CA_Range1"), CN.Name) > 0
    Next CN

With ActiveSheet.PivotTables("CampaignName").PivotFields("Campaign Code")
.ClearAllFilters
    For Each CN2 In .PivotItems
        CN2.Visible = WorksheetFunction.CountIf(Range("CA_Range1"), CN2.Name) > 0
    Next CN2

With ActiveSheet.PivotTables("Itinerary").PivotFields("Campaign Code")
.ClearAllFilters
    For Each IT In .PivotItems
        IT.Visible = WorksheetFunction.CountIf(Range("CA_Range1"), IT.Name) > 0
    Next IT

With ActiveSheet.PivotTables("Segment").PivotFields("Campaign Code")
.ClearAllFilters
    For Each SG In .PivotItems
        SG.Visible = WorksheetFunction.CountIf(Range("CA_Range1"), SG.Name) > 0
    Next SG

**-- so I would like the ActiveSheet.PivotTables("Segment").PivotFields("ReportDate") to equal a referencing calculated date cell on the same sheet e.g. cell Z4 = 12/02/2017**

End With
End With
End With
End With
End With
End With
End With
End With

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
ActiveSheet.DisplayPageBreaks = False
Application.DisplayStatusBar = True
Application.DisplayAlerts = True

End Sub

【讨论】：

上面的代码也需要很长时间才能运行所有数据透视表。您知道如何更有效地过滤多个数据透视表吗？

【解决方案2】：

首先，让我们像这样重构您的代码。这样做应该更容易调试。

Sub Test()

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False
Application.DisplayStatusBar = False
Application.DisplayAlerts = False

Dim pi as PivotItem
Dim pt as PivotTable
Dim ws as Worksheet

Set ws = ActiveSheet ' It is best not to use activesheet and to instead
                     ' go through "ThisWorkbook.Sheets("") or something similar.


' This loop will allow us to prevent pivot tables from updating automatically
' Doing this should speed up your code dramatically.
For each pt in ws.PivotTables
    pt.ManualUpdate = True
Next


With ws.PivotTables("CampaignAnalysis").PivotFields("Campaign  Code")
    .ClearAllFilters
    ' This loop right here is going to cause an issue. If there is ever an instance
    ' where all pivotitems would be hidden by this loop, then you will encounter an error.
    ' It is best to set at least one item visible, and then loop through the items to set
    ' the other items to hidden.

    For Each pi In .PivotItems
        .Visible = WorksheetFunction.CountIf(ws.Range("CA_Range1"), pi.Name) > 0
    Next
End With

With ws.PivotTables("MailCount").PivotFields("Campaign Code")
    .ClearAllFilters
    For Each pi In .PivotItems
        pi.Visible = WorksheetFunction.CountIf(ws.Range("CA_Range1"), pi.Name) > 0
    Next
End With

With ws.PivotTables("AgeRange").PivotFields("Campaign Code")
    .ClearAllFilters

    For Each pi In .PivotItems
        pi.Visible = WorksheetFunction.CountIf(ws.Range("CA_Range1"), pi.Name) > 0
    Next
End With

With ws.PivotTables("DrivablePort").PivotFields("Campaign Code")
    .ClearAllFilters

    For Each pi In .PivotItems
        pt.Visible = WorksheetFunction.CountIf(ws.Range("CA_Range1"), pi.Name) > 0
    Next
End With

With ws.PivotTables("CruiseName").PivotFields("Campaign Code")
    .ClearAllFilters

    For Each pi In .PivotItems
        pi.Visible = WorksheetFunction.CountIf(ws.Range("CA_Range1"), pi.Name) > 0
    Next
End With

With ws.PivotTables("CampaignName").PivotFields("Campaign Code")
    .ClearAllFilters

    For Each pi In .PivotItems
        pi.Visible = WorksheetFunction.CountIf(ws.Range("CA_Range1"), pi.Name) > 0
    Next
End With

With ws.PivotTables("Itinerary").PivotFields("Campaign Code")
    .ClearAllFilters

    For Each pi In .PivotItems
        pi.Visible = WorksheetFunction.CountIf(ws.Range("CA_Range1"), pi.Name) > 0
    Next pi
End With

With ws.PivotTables("Segment").PivotFields("Campaign Code")
    .ClearAllFilters

    For Each pi In .PivotItems
        pi.Visible = WorksheetFunction.CountIf(ws.Range("CA_Range1"), pi.Name) > 0
    Next pi
End With

'**-- so I would like the ActiveSheet.PivotTables("Segment").PivotFields("ReportDate") to equal a referencing calculated date cell on the same sheet e.g. cell Z4 = 12/02/2017**

For each pt in ws.PivotTables
    pt.ManualUpdate = False
Next

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
ActiveSheet.DisplayPageBreaks = False
Application.DisplayStatusBar = True
Application.DisplayAlerts = True

End Sub

如代码中的 cmets 所述，用于隐藏 PivotItems 的方法会遇到问题。过滤数据透视字段时，您会在尝试隐藏最后一个数据透视项时收到错误消息。例如，如果您有 5 个项目可见，总共 10 个项目，但在循环期间，前 5 个被循环通过并且它们都设置为不可见，那么您将在第 5 个项目上遇到错误，无论 6-10 是否应该可见。

据我所知，您正在将所有数据透视表过滤到“广告系列代码”中的相同项目。为什么不使用切片器来完成这项任务？它更适合处理这种过程。

【讨论】：