使用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 

希望這可以幫助你。