Filtrowanie tabeli przestawnej programu Excel przy użyciu VBA

Question

Próbowałem już teraz kopiować i wklejać rozwiązania z Internetu, aby spróbować filtrować tabelę przestawną w programie Excel przy użyciu języka VBA. Poniższy kod nie działa.

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 

Chcę filtrować, więc widzę wszystkie wiersze, które mają SavedFamilyCode K123223. Nie chcę widzieć żadnych innych wierszy w tabeli przestawnej. Chcę, żeby to działało bez względu na poprzednie filtry. Mam nadzieję, że możesz mi w tym pomóc. Dzięki!

---

podstawie Twojego posta Staram:

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 

Niestety dostaję Run time error 91: Object zmienną lub ze zmienną blok nie jest ustawiona. Co spowodowało ten błąd?

Answer 1

Konfiguracja stołu obrotowego tak, że jest tak:

Twój kod może po prostu pracować na zakresie („B1”) i teraz tabela pivot będą filtrowane do ciebie wymagane SavedFamilyCode

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

Answer 2

Field.CurrentPage działa tylko w polach Filtr (zwanych również polami strony).
Jeśli chcesz filtrować pole wiersz/kolumnę, trzeba przejść przez poszczególnych elementów, tak jak poniżej:

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 

Wtedy byś po prostu zadzwoń:

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

Naturalnie, robi się wolniej, im więcej różnych przedmiotów jest na polu. Możesz także użyć SourceName zamiast Name, jeśli lepiej pasujesz do twoich potrzeb.

Answer 3

Myślę, że rozumiem twoje pytanie. Spowoduje to filtrowanie elementów znajdujących się w etykietach kolumn lub etykietach wierszy. Ostatnie 2 sekcje kodu są tym, czego potrzebujesz, ale wklejam je w całość, abyś mógł dokładnie zobaczyć, jak to działa, zaczyna się od wszystkiego, co jest zdefiniowane itd. Zdecydowanie wziąłem niektóre z tego kodu z innych stron fyi.

Pod koniec kodu "WardClinic_Category" jest kolumną moich danych i etykietą kolumny tabeli przestawnej. To samo dotyczy IVUDDCIndicator (jest to kolumna w moich danych, ale w etykiecie wiersza tabeli przestawnej).

Mam nadzieję, że to pomaga innym ... bardzo trudno jest znaleźć kod, który zrobił to "właściwą drogą", zamiast używać kodu podobnego do rejestratora makr.

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

Najnowsze wersje programu Excel mają nowe narzędzie o nazwie Krajalnice. Używanie fragmentatorów w VBA jest w rzeczywistości bardziej niezawodne niż funkcja .CurrentPage (pojawiły się zgłoszenia błędów podczas przeglądania wielu opcji filtrowania). Oto prosty przykład, jak można wybrać pozycję krajalnicy (pamiętaj, aby usunąć zaznaczenie wszystkich bez odpowiednich wartości krajalnic):

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 

Istnieją również usługi takie jak SmartKato, które pomogą Ci się z konfigurowania paneli kontrolnych lub zgłoś i/lub napraw swój kod.

Answer 5

W programie Excel 2007 roku, można użyć znacznie prostszy kod w następujący sposób:

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

Można to sprawdzić, jeśli chcesz. :)

użyć tego kodu, jeśli SavedFamilyCode jest w raporcie filtr:

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 

Ale jeśli SavedFamilyCode jest w kolumnie lub wierszu Etykiety użyć tego kodu:

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 

Mam nadzieję, że to ci pomoże.