使用 VBA 过滤 Excel 数据透视表

Posted 2023-02-27

技术标签:

【中文标题】使用 VBA 过滤 Excel 数据透视表【英文标题】：Filter Excel pivot table using VBA 【发布时间】：2012-06-19 18:18:04 【问题描述】：

我现在一直尝试从互联网上复制和粘贴解决方案，以尝试使用 VBA 在 Excel 中过滤数据透视表。下面的代码不起作用。

Sub FilterPivotTable()
    Application.ScreenUpdating = False
    ActiveSheet.PivotTables("PivotTable2").ManualUpdate = True
    ActiveSheet.PivotTables("PivotTable2").PivotFields("SavedFamilyCode").CurrentPage = "K123223"
    ActiveSheet.PivotTables("PivotTable2").ManualUpdate = False
    Application.ScreenUpdating = True
End Sub

我想过滤，以便看到所有具有 SavedFamilyCode K123223 的行。我不想在数据透视表中看到任何其他行。无论以前的过滤器如何，我都希望它能够正常工作。我希望你能帮我解决这个问题。谢谢！

根据您的帖子，我正在尝试：

Sub FilterPivotField()
    Dim Field As PivotField
    Field = ActiveSheet.PivotTables("PivotTable2").PivotFields("SavedFamilyCode")
    Value = Range("$A$2")
    Application.ScreenUpdating = False
    With Field
        If .Orientation = xlPageField Then
            .CurrentPage = Value
        ElseIf .Orientation = xlRowField Or .Orientation = xlColumnField Then
            Dim i As Long
            On Error Resume Next ' Needed to avoid getting errors when manipulating fields that were deleted from the data source.
            ' Set first item to Visible to avoid getting no visible items while working
            .PivotItems(1).Visible = True
            For i = 2 To Field.PivotItems.Count
                If .PivotItems(i).Name = Value Then _
                    .PivotItems(i).Visible = True Else _
                    .PivotItems(i).Visible = False
            Next i
            If .PivotItems(1).Name = Value Then _
                .PivotItems(1).Visible = True Else _
                .PivotItems(1).Visible = False
        End If
    End With
    Application.ScreenUpdating = True
End Sub

不幸的是，我收到运行时错误 91：对象变量或未设置块变量。是什么导致了这个错误？

【问题讨论】：

您尝试录制宏吗？我得到了一些类似于 Sub FilterPivotTable() With ActiveSheet.PivotTables("PivotTable2").PivotFields("SavedFamilyCode") .PivotItems("K010").Visible = True .PivotItems(" K012").Visible = False End With End Sub 但我希望除 K010 之外的所有内容都变为不可见宏记录器忽略我的选择/取消选择所有点击 【参考方案1】：

Field.CurrentPage 仅适用于过滤器字段（也称为页面字段）。如果要过滤行/列字段，则必须循环浏览各个项目，如下所示：

Sub FilterPivotField(Field As PivotField, Value)
    Application.ScreenUpdating = False
    With Field
        If .Orientation = xlPageField Then
            .CurrentPage = Value
        ElseIf .Orientation = xlRowField Or .Orientation = xlColumnField Then
            Dim i As Long
            On Error Resume Next ' Needed to avoid getting errors when manipulating PivotItems that were deleted from the data source.
            ' Set first item to Visible to avoid getting no visible items while working
            .PivotItems(1).Visible = True
            For i = 2 To Field.PivotItems.Count
                If .PivotItems(i).Name = Value Then _
                    .PivotItems(i).Visible = True Else _
                    .PivotItems(i).Visible = False
            Next i
            If .PivotItems(1).Name = Value Then _
                .PivotItems(1).Visible = True Else _
                .PivotItems(1).Visible = False
        End If
    End With
    Application.ScreenUpdating = True
End Sub

然后，您只需调用：

FilterPivotField ActiveSheet.PivotTables("PivotTable2").PivotFields("SavedFamilyCode"), "K123223"

当然，该字段中的单个不同项目越多，此过程就越慢。如果更适合您的需要，您也可以使用 SourceName 代替 Name。

【讨论】：

回复@user1283776（迟到一年总比没有好）-您可能会收到错误，因为您应该使用Set Field = ... 为我工作可以节省我几个小时的时间！【参考方案2】：

配置数据透视表，使其如下所示：

您的代码现在可以简单地在 range("B1") 上工作，并且数据透视表将被过滤为您所需的 SavedFamilyCode

Sub FilterPivotTable()
Application.ScreenUpdating = False
    ActiveSheet.Range("B1") = "K123224"
Application.ScreenUpdating = True
End Sub

【讨论】：

【参考方案3】：

如果您愿意，可以检查一下。 :)

如果 SavedFamilyCode 在报告过滤器中，请使用此代码：

 Sub FilterPivotTable()
   Application.ScreenUpdating = False
   ActiveSheet.PivotTables("PivotTable2").ManualUpdate = True

   ActiveSheet.PivotTables("PivotTable2").PivotFields("SavedFamilyCode").ClearAllFilters

   ActiveSheet.PivotTables("PivotTable2").PivotFields("SavedFamilyCode").CurrentPage = _
      "K123223"

  ActiveSheet.PivotTables("PivotTable2").ManualUpdate = False
  Application.ScreenUpdating = True
  End Sub

但如果 SavedFamilyCode 位于列或行标签中，请使用此代码：

 Sub FilterPivotTable()
     Application.ScreenUpdating = False
     ActiveSheet.PivotTables("PivotTable2").ManualUpdate = True

      ActiveSheet.PivotTables("PivotTable2").PivotFields("SavedFamilyCode").ClearAllFilters

      ActiveSheet.PivotTables("PivotTable2").PivotFields("SavedFamilyCode").PivotFilters. _
    Add Type:=xlCaptionEquals, Value1:="K123223"

  ActiveSheet.PivotTables("PivotTable2").ManualUpdate = False
  Application.ScreenUpdating = True
  End Sub

希望对你有所帮助。

【讨论】：

【参考方案4】：

我想我理解你的问题。这会过滤列标签或行标签中的内容。代码的最后 2 部分是您想要的，但我粘贴了所有内容，以便您可以准确地看到它是如何运行的，从定义的所有内容开始到结束等等。我肯定从其他站点获取了一些代码，仅供参考。

在代码末尾附近，“WardClinic_Category”是我的数据列，位于数据透视表的列标签中。 IVUDDCIndicator 也是如此（它在我的数据中是一列，但在数据透视表的行标签中）。

希望这对其他人有所帮助...我发现很难找到以“正确方式”执行此操作的代码，而不是使用类似于宏记录器的代码。

Sub CreatingPivotTableNewData()


'Creating pivot table
Dim PvtTbl As PivotTable
Dim wsData As Worksheet
Dim rngData As Range
Dim PvtTblCache As PivotCache
Dim wsPvtTbl As Worksheet
Dim pvtFld As PivotField

'determine the worksheet which contains the source data
Set wsData = Worksheets("Raw_Data")

'determine the worksheet where the new PivotTable will be created
Set wsPvtTbl = Worksheets("3N3E")

'delete all existing Pivot Tables in the worksheet
'in the TableRange1 property, page fields are excluded; to select the entire PivotTable report, including the page fields, use the TableRange2 property.
For Each PvtTbl In wsPvtTbl.PivotTables
If MsgBox("Delete existing PivotTable!", vbYesNo) = vbYes Then
PvtTbl.TableRange2.Clear
End If
Next PvtTbl


'A Pivot Cache represents the memory cache for a PivotTable report. Each Pivot Table report has one cache only. Create a new PivotTable cache, and then create a new PivotTable report based on the cache.

'set source data range:
Worksheets("Raw_Data").Activate
Set rngData = wsData.Range(Range("A1"), Range("H1").End(xlDown))


'Creates Pivot Cache and PivotTable:
Worksheets("Raw_Data").Activate
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=rngData.Address, Version:=xlPivotTableVersion12).CreatePivotTable TableDestination:=wsPvtTbl.Range("A1"), TableName:="PivotTable1", DefaultVersion:=xlPivotTableVersion12
Set PvtTbl = wsPvtTbl.PivotTables("PivotTable1")

'Default value of ManualUpdate property is False so a PivotTable report is recalculated automatically on each change.
'Turn this off (turn to true) to speed up code.
PvtTbl.ManualUpdate = True


'Adds row and columns for pivot table
PvtTbl.AddFields RowFields:="VerifyHr", ColumnFields:=Array("WardClinic_Category", "IVUDDCIndicator")

'Add item to the Report Filter
PvtTbl.PivotFields("DayOfWeek").Orientation = xlPageField


'set data field - specifically change orientation to a data field and set its function property:
With PvtTbl.PivotFields("TotalVerified")
.Orientation = xlDataField
.Function = xlAverage
.NumberFormat = "0.0"
.Position = 1
End With

'Removes details in the pivot table for each item
Worksheets("3N3E").PivotTables("PivotTable1").PivotFields("WardClinic_Category").ShowDetail = False

'Removes pivot items from pivot table except those cases defined below (by looping through)
For Each PivotItem In PvtTbl.PivotFields("WardClinic_Category").PivotItems
    Select Case PivotItem.Name
        Case "3N3E"
            PivotItem.Visible = True
        Case Else
            PivotItem.Visible = False
        End Select
    Next PivotItem


'Removes pivot items from pivot table except those cases defined below (by looping through)
For Each PivotItem In PvtTbl.PivotFields("IVUDDCIndicator").PivotItems
    Select Case PivotItem.Name
        Case "UD", "IV"
            PivotItem.Visible = True
        Case Else
            PivotItem.Visible = False
        End Select
    Next PivotItem

'turn on automatic update / calculation in the Pivot Table
PvtTbl.ManualUpdate = False


End Sub

【讨论】：

【参考方案5】：

最新版本的 Excel 有一个名为 Slicers 的新工具。在 VBA 中使用切片器实际上比 .CurrentPage 更可靠（在循环多个过滤器选项时有错误报告）。下面是一个简单示例，说明如何选择切片器项（记得取消选择所有不相关的切片器值）：

Sub Step_Thru_SlicerItems2()
Dim slItem As SlicerItem
Dim i As Long
Dim searchName as string

Application.ScreenUpdating = False
searchName="Value1"

    For Each slItem In .VisibleSlicerItems
        If slItem.Name <> .SlicerItems(1).Name Then _
            slItem.Selected = False
        Else
            slItem.Selected = True
        End if
    Next slItem
End Sub

还有诸如 SmartKato 之类的服务可以帮助您设置仪表板或报告和/或修复您的代码。

【讨论】：

这看起来很有趣，但是“.VisibleSlicerItems”之前是什么？是 worksheet.VisibleSlicerItems 吗？ pivottable.VisibleSlicerItems?【参考方案6】：

在 Excel 2007 及更高版本中，您可以使用更简单的代码和更精确的参考：

dim pvt as PivotTable
dim pvtField as PivotField

set pvt = ActiveSheet.PivotTables("PivotTable2")
set pvtField = pvt.PivotFields("SavedFamilyCode")

pvtField.PivotFilters.Add xlCaptionEquals, Value1:= "K123223"

【讨论】：

以上是关于使用 VBA 过滤 Excel 数据透视表的主要内容，如果未能解决你的问题，请参考以下文章

加快数据透视表过滤 VBA 代码

在 Excel 2003 中筛选数据透视表

使用 VBA 根据下拉选择过滤多个数据透视表

过滤数据透视表的最后一项 (vba)

Excel 使用 VBA 遍历嵌套的数据透视表行字段

如何刷新数据透视图