使用VBA过滤Excel数据透视表

Question

我曾尝试从互联网永远复制和粘贴解决方案，现在尝试使用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：对象没有设置变量或With块变量。是什么导致了这个错误？

Answer 1

配置数据透视表，以便它是这样的：

您的代码可以简单地在范围（“B1”）现在的工作和数据透视表将被过滤，你需要SavedFamilyCode

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

Answer 2

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。

Answer 3

我想我理解你的问题。这将过滤列标签或行标签中的内容。代码的最后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 

Answer 4

最新版本的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服务，将帮助您与设置您的仪表板或报告和/或修复你的代码。

Answer 5

在Excel 2007年起，你可以按如下方式使用更简单的代码：

dim pvt as PivotTable 
dim pvtField as PivotField 

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

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

Answer 6

，如果你喜欢，你可以检查此。 :)

使用此代码，如果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 

希望这可以帮助你。