使用VBA筛选Excel数据透视表

我一直尝试从internet复制和粘贴解决方案，以尝试使用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

我想进行筛选，以便查看已保存FamilyCode 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：未设置对象变量或With block变量。导致此错误的原因是什么？

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

您的代码现在可以在范围（“B1”）上工作，透视表将被过滤到您所需的SavedFamilyCode

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

---

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。

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

在代码末尾，“WardClinic_类别”是我的数据的一列，位于透视表的列标签中。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

---

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

子步骤通过MS2（）
像切片一样暗淡的切片
我想我会坚持多久
将searchName设置为字符串
Application.ScreenUpdating=False
searchName=“Value1”
对于.VisibleSlicerItems中的每个slItem
如果slItem.Name.SlicerItems（1.Name），则_
slItem.Selected=False
其他的
slItem.Selected=True
如果结束
下一个项目
端接头

---

还有一些像SmartKato这样的服务可以帮助您设置仪表板或报表和/或修复代码。

在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"

---

如果您愿意，可以检查此项。：）

如果报告筛选器中存在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

 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

但如果保存的FamilyCode位于列或行标签中，请使用以下代码：

 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

 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

---

希望这对您有所帮助。

您试过录制宏吗？我通过ActiveSheet.PivotTables（“PivotTable2”）。PivotFields（“SavedFamilyCode”）。PivotItems（“K010”）。Visible=True。PivotItems（“K012”）得到了一些类似于Sub FilterPivotTable（）的信息.Visible=带End Sub的False End，但我希望K010之外的所有内容都不可见宏录制器忽略我在回复@user1283776时的选择/取消选择所有单击（晚一年总比不选择好）--您可能会收到错误，因为您应该使用

设置字段=为我工作节省我几个小时的时间！这看起来很有趣，但在“.VisibleSlicerItems”之前是什么？这是工作表吗？数据透视表.VisibleSlicerItems？