Note: The other languages of the website are Google-translated. Back to English

Jak filtrować tabelę przestawną na podstawie określonej wartości komórki w programie Excel?

Zwykle filtrujemy dane w tabeli przestawnej, wybierając elementy z listy rozwijanej, jak pokazano na zrzucie ekranu poniżej. W rzeczywistości możesz filtrować tabelę przestawną na podstawie wartości w określonej komórce. Metoda VBA w tym artykule pomoże ci rozwiązać problem.

Filtruj tabelę przestawną na podstawie określonej wartości komórki z kodem VBA


Filtruj tabelę przestawną na podstawie określonej wartości komórki z kodem VBA

Poniższy kod VBA może pomóc w filtrowaniu tabeli przestawnej na podstawie określonej wartości komórki w programie Excel. Wykonaj następujące czynności.

1. Wprowadź wcześniej wartość, na podstawie której będziesz filtrować tabelę przestawną w komórce (tutaj wybieram komórkę H6).

2. Otwórz arkusz zawierający tabelę przestawną, którą będziesz filtrować według wartości komórki. Następnie kliknij prawym przyciskiem myszy kartę arkusza i wybierz Wyświetl kod z menu kontekstowego. Zobacz zrzut ekranu:

3. W otwarciu Microsoft Visual Basic for Applications skopiuj poniższy kod VBA do okna Code.

Kod VBA: Filtruj tabelę przestawną na podstawie wartości komórki

Private Sub Worksheet_Change(ByVal Target As Range)
'Update by Extendoffice 20180702
    Dim xPTable As PivotTable
    Dim xPFile As PivotField
    Dim xStr As String
    On Error Resume Next
    If Intersect(Target, Range("H6:H7")) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Set xPTable = Worksheets("Sheet1").PivotTables("PivotTable2")
    Set xPFile = xPTable.PivotFields("Category")
    xStr = Target.Text
    xPFile.ClearAllFilters
    xPFile.CurrentPage = xStr
    Application.ScreenUpdating = True
End Sub

Uwagi: W kodzie

1) "Sheet1”To nazwa arkusza.
2) "Tabela przestawna 2”To nazwa tabeli przestawnej.
3) Pole filtrujące w tabeli przestawnej nosi nazwę „Wszystkie produkty".
4) Wartość, którą chcesz przefiltrować w tabeli przestawnej, zostanie umieszczona w komórce H6.
Możesz zmienić powyższe wartości zmiennych według potrzeb.

4. wciśnij inny + Q klucze do zamknięcia Microsoft Visual Basic for Applications okno.

Następnie tabela przestawna filtruje na podstawie wartości w komórce H6, jak pokazano na poniższym zrzucie ekranu:

W razie potrzeby możesz zmienić wartość komórki na inną.

Uwagi: Wartości wpisane w komórce H6 powinny dokładnie odpowiadać wartościom na liście rozwijanej Kategoria w tabeli przestawnej.


Podobne artykuły:


Najlepsze narzędzia biurowe

Kutools dla programu Excel rozwiązuje większość problemów i zwiększa produktywność o 80%

  • Ponowne użycie: Szybko włóż złożone wzory, wykresy i wszystko, czego używałeś wcześniej; Szyfruj komórki z hasłem; Utwórz listę mailingową i wysyłaj e-maile ...
  • Pasek Super Formula (łatwo edytować wiele wierszy tekstu i formuły); Układ do czytania (łatwe odczytywanie i edytowanie dużej liczby komórek); Wklej do filtrowanego zakresu...
  • Scal komórki / wiersze / kolumny bez utraty danych; Podziel zawartość komórek; Połącz zduplikowane wiersze / kolumny... Zapobiegaj zduplikowanym komórkom; Porównaj zakresy...
  • Wybierz Duplikat lub Unikalny Wydziwianie; Wybierz puste wiersze (wszystkie komórki są puste); Super Find i Fuzzy Find w wielu zeszytach ćwiczeń; Losowy wybór ...
  • Dokładna kopia Wiele komórek bez zmiany odwołania do formuły; Automatyczne tworzenie odniesień do wielu arkuszy; Wstaw punktory, Pola wyboru i nie tylko ...
  • Wyodrębnij tekst, Dodaj tekst, Usuń według pozycji, Usuń przestrzeń; Tworzenie i drukowanie podsumowań stronicowania; Konwertuj zawartość komórek i komentarze...
  • Super filtr (zapisz i zastosuj schematy filtrów do innych arkuszy); Zaawansowane sortowanie według miesiąca / tygodnia / dnia, częstotliwości i innych; Specjalny filtr pogrubieniem, kursywą ...
  • Połącz skoroszyty i arkusze robocze; Scal tabele na podstawie kluczowych kolumn; Podziel dane na wiele arkuszy; Konwersja wsadowa xls, xlsx i PDF...
  • Ponad 300 zaawansowanych funkcji. Obsługuje Office / Excel 2007-2021 i 365. Obsługuje wszystkie języki. Łatwe wdrażanie w przedsiębiorstwie lub organizacji. Pełne funkcje 30-dniowa bezpłatna wersja próbna. 60-dniowa gwarancja zwrotu pieniędzy.
karta kte 201905

Karta Office wprowadza interfejs z zakładkami do pakietu Office i znacznie ułatwia pracę

  • Włącz edycję i czytanie na kartach w programach Word, Excel, PowerPoint, Publisher, Access, Visio i Project.
  • Otwieraj i twórz wiele dokumentów w nowych kartach tego samego okna, a nie w nowych oknach.
  • Zwiększa produktywność o 50% i redukuje setki kliknięć myszką każdego dnia!
officetab dół
Sortuj komentarze według
Komentarze (23)
Brak ocen. Oceń jako pierwszy!
Ten komentarz został zminimalizowany przez moderatora na stronie
Używając tego kodu (oczywiście zaktualizowanego dla moich zmiennych), podczas zmiany pola filtr zmienia się chwilowo na poprawny, a następnie prawie natychmiast się usuwa. Próbuję dowiedzieć się, dlaczego to robi (zastanawiasz się, czy ma to coś wspólnego z ClearAllFilters na końcu podstrony?)
Ten komentarz został zminimalizowany przez moderatora na stronie
Jak byś to zrobił z filtrem raportu, który ma hierarchię?
Ten komentarz został zminimalizowany przez moderatora na stronie
Hej! Dzięki za twoje makro.

Próbowałem użyć go dla więcej niż jednej tabeli przestawnej na tej samej stronie, ale to nie działa. Napisałem to tak:

Prywatny Sub Worksheet_Change (ByVal Target As Range)
Dim xPTable1 jako tabela przestawna
Dim xPFile1 jako PivotField
Dim xStr1 jako ciąg
On Error Resume Next
Jeśli przecięcie(cel, zakres("D7")) jest niczym, to zakończ Sub
Application.ScreenUpdating = Fałsz
Ustaw xPTable1 = Worksheets("BUSCADOR").PivotTables("PV_ETAPA1")
Ustaw xPFile1 = xPTable1.PivotFields("ETAPA1")
xStr1 = Cel.Tekst
xPFile1. Wyczyść wszystkie filtry
xPFile1.CurrentPage = xStr1
Application.ScreenUpdating = True

Dim xPTable2 jako tabela przestawna
Dim xPFile2 jako PivotField
Dim xStr2 jako ciąg
On Error Resume Next
Jeśli przecięcie(cel, zakres("G7")) jest niczym, to zakończ Sub
Application.ScreenUpdating = Fałsz
Ustaw xPTable2 = Worksheets("BUSCADOR").PivotTables("PV_ETAPA2")
Ustaw xPFile2 = xPTable2.PivotFields("ETAPA2")
xStr2 = Cel.Tekst
xPFile2. Wyczyść wszystkie filtry
xPFile2.CurrentPage = xStr2
Application.ScreenUpdating = True

End Sub

Może możesz mi pomóc!

Dzięki z góry!
Ten komentarz został zminimalizowany przez moderatora na stronie
Hi


dzięki za makro


Próbuję tego samego, ale nie mogę zmusić go do pracy na 2 stołach. oboje patrzą na tę samą komórkę, tylko 2 różne tabele przestawne


dzięki
Ten komentarz został zminimalizowany przez moderatora na stronie
Musisz zmienić nazwę tabeli przestawnej. Każda tabela przestawna ma inną nazwę. aby to uzyskać, kliknij prawym przyciskiem myszy na osi i wybierz ustawienia tabeli przestawnej, nazwa będzie na górze
Ten komentarz został zminimalizowany przez moderatora na stronie
Witam,

Je ne comprends pas komentarz ajouter le nom du second TCD dans la macro pour que cela fonctionne sur les deux.
Pourriez vous m'aider?

dziękuję
Ten komentarz został zminimalizowany przez moderatora na stronie
Witam z jakiegoś powodu to makro po wejściu na stronę visual basic w ogóle się nie wyświetla. Nie mogę włączyć/uruchomić tego makra, sprawdziłem wszystkie ustawienia centrum zaufania, ale nic się nie dzieje, proszę o pomoc
Ten komentarz został zminimalizowany przez moderatora na stronie
Cześć, wydaje mi się, że to nie działa. Komórka, do której chcę się odwołać, jest pobierana z formuły — czy to dlatego filtr nie może jej znaleźć, ponieważ patrzy na formułę, a nie na wartość zwracaną przez formułę? Z góry dziękuję Heather McDonagh
Ten komentarz został zminimalizowany przez moderatora na stronie
Cześć Heather, czy znalazłeś rozwiązanie. Mam ten sam problem.
Ten komentarz został zminimalizowany przez moderatora na stronie
Udało mi się zmodyfikować/przefiltrować 3 różne czopy, które znajdują się na tej samej karcie. Dodałem również wiersz w moim zestawie danych „Nie znaleziono danych”, w przeciwnym razie pozostawiłem filtr na „WSZYSTKO”, czego nie chciałem. Powyższe bardzo pomogło mi zdobyć Kudos z zarządzaniem, więc chciałem się podzielić. Zauważ, że (Wszystko) rozróżnia wielkość liter, trochę mi to zajęło.
Prywatny Sub Worksheet_Change (ByVal Target As Range)
'test
Przyciemnij xPTable jako tabelę przestawną
Dim xPFile jako PivotField
Dim xStr jako ciąg

Dim x2PTable jako tabela przestawna
Dim x2PFFile As PivotField
Dim x2Str jako ciąg

Dim x3PTable jako tabela przestawna
Dim x3PFFile As PivotField
Dim x3Str jako ciąg

On Error Resume Next
Jeśli przecięcie(cel, zakres("a2:e2")) jest niczym, to zakończ Sub

Application.ScreenUpdating = Fałsz

'tbl-1'
Ustaw xPTable = Worksheets("Graphical").PivotTables("PivotTable1")
Ustaw xPFile = xPTable.PivotFields("Dział MR — Dział")
xStr = Cel.Tekst
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr
If xPFile.CurrentPage = "(All)" Then xPFile.CurrentPage = "Nie znaleziono danych"

'tbl-2'
Ustaw x2PTable = Worksheets("Graphical").PivotTables("PivotTable2")
Ustaw x2PFile = x2PTable.PivotFields("Dział MR — Dział")
x2Str = Cel.Tekst
x2PFile. Wyczyść wszystkie filtry
x2PFile.CurrentPage = x2Str
If x2PFile.CurrentPage = "(All)" Then x2PFile.CurrentPage = "Nie znaleziono danych"

'tbl-3'
Ustaw x3PTable = Worksheets("Graphical").PivotTables("PivotTable3")
Ustaw x3PFile = x3PTable.PivotFields("Dział MR — Dział")
x3Str = Cel.Tekst
x3PFile. Wyczyść wszystkie filtry
x3PFile.CurrentPage = x3Str
If x3PFile.CurrentPage = "(All)" Then x3PFile.CurrentPage = "Nie znaleziono danych"

Application.ScreenUpdating = True

End Sub
Ten komentarz został zminimalizowany przez moderatora na stronie
Czy jest to możliwe z arkuszami Google? Jeśli tak to jak?
Ten komentarz został zminimalizowany przez moderatora na stronie
Arkusze Google nie wymagają żadnej tabeli przestawnej. możesz wykonać bezpośrednio za pomocą funkcji filtrowania
Ten komentarz został zminimalizowany przez moderatora na stronie
Chciałbym użyć wielu kodów zmiany arkusza roboczego w tym samym arkuszu. Jak to zrobić? Mój kod jest jak poniżej:
Prywatny Sub Worksheet_Change (ByVal Target As Range)
'Filtr tabeli przestawnej na podstawie wartości komórki
Przyciemnij xPTable jako tabelę przestawną
Dim xPFile jako PivotField
Dim xStr jako ciąg
On Error Resume Next
Jeśli przecięcie(cel, zakres("D20:D21")) jest niczym, to zakończ Sub
Application.ScreenUpdating = Fałsz
Ustaw xPTable = Worksheets("Arkusz1").PivotTables("PivotTable2")
Ustaw xPFile = xPTable.PivotFields("Oznaczenie")
xStr = Cel.Tekst
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr
Application.ScreenUpdating = True
End Sub

Private Sub Worksheet_Change2 (ByVal Target As Range)
„Filtr tabeli przestawnej na podstawie wartości komórki 2”
Przyciemnij xPTable jako tabelę przestawną
Dim xPFile jako PivotField
Dim xStr jako ciąg
On Error Resume Next
Jeśli przecięcie(cel, zakres("H20:H21")) jest niczym, to zakończ Sub
Application.ScreenUpdating = Fałsz
Ustaw xPTable = Worksheets("Arkusz1").PivotTables("PivotTable2")
Ustaw xPFile = xPTable.PivotFields("Oferta")
xStr = Cel.Tekst
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr
Application.ScreenUpdating = True
End Sub
Ten komentarz został zminimalizowany przez moderatora na stronie
Olá, gostaria de sabre se quisesse filtrar mais de uma categoria como poderia ser?
Ten komentarz został zminimalizowany przez moderatora na stronie
Co zrobić, jeśli chcę połączyć komórkę wyboru z inną kartą? To jest mój dotychczasowy kod
Prywatny Sub Worksheet_Change (ByVal Target As Range)
Dim xPTable1 jako tabela przestawna
Dim xPFile1 jako PivotField
Dim xStr1 jako ciąg
On Error Resume Next
Jeśli przecięcie(cel, zakres("B1")) jest niczym, to zakończ Sub
Application.ScreenUpdating = Fałsz
Ustaw xPTable1 = Arkusze("SM_SKU PIVOTS").PivotTables("PivotTable1")
Ustaw xPFile1 = xPTable1.PivotFields("Geografia")
xStr1 = Cel.Tekst
xPFile1. Wyczyść wszystkie filtry
xPFile1.CurrentPage = xStr1
Application.ScreenUpdating = True

Dim xPTable2 jako tabela przestawna
Dim xPFile2 jako PivotField
Dim xStr2 jako ciąg
On Error Resume Next
Jeśli przecięcie(cel, zakres("B1")) jest niczym, to zakończ Sub
Application.ScreenUpdating = Fałsz
Ustaw xPTable2 = Arkusze("SM_SKU PIVOTS").PivotTables("PivotTable4")
Ustaw xPFile2 = xPTable2.PivotFields("Geografia")
xStr2 = Cel.Tekst
xPFile2. Wyczyść wszystkie filtry
xPFile2.CurrentPage = xStr2
Application.ScreenUpdating = True

Dim xPTable3 jako tabela przestawna
Dim xPFile3 jako PivotField
Dim xStr3 jako ciąg
On Error Resume Next
Jeśli przecięcie(cel, zakres("B1")) jest niczym, to zakończ Sub
Application.ScreenUpdating = Fałsz
Ustaw xPTable3 = Arkusze("SM_SKU PIVOTS").PivotTables("PivotTable8")
Ustaw xPFile3 = xPTable3.PivotFields("Geografia")
xStr3 = Cel.Tekst
xPFile3. Wyczyść wszystkie filtry
xPFile3.CurrentPage = xStr3
Application.ScreenUpdating = True

End Sub
Ten komentarz został zminimalizowany przez moderatora na stronie
Witaj!

Jestem nowy w VBA i chciałbym mieć kod do wyboru filtra przestawnego na podstawie zakresu komórek.
Jak zmienić "CurrentPage" na wartość zakresu?
Dziękuję Ci!!
-------------------------------------------------- -----------------------------------------
Sub PrintTour()

ActiveSheet.PivotTables("Tabela przestawna1").Pola przestawne( _
„[Bereich 1].[Wycieczka].[Wycieczka]”). _
Wyczyść wszystkie filtry
ActiveSheet.PivotTables("Tabela przestawna1").Pola przestawne( _
„[Bereich 1] [Wycieczka]. [Wycieczka]”). _
Bieżąca strona = "[Bereich 1].[Tour lt. Anlieferungstag].&[4001-01]"
End Sub
Ten komentarz został zminimalizowany przez moderatora na stronie
Dziękuję bardzo za ten kod! Udało mi się działać po dostosowaniu do moich pól, ale po sformatowaniu kilku zmian w moim arkuszu teraz nie działa! Przeniosłem go z A1 do B1, zmieniłem formatowanie komórek, aby się wyróżniał itp. Nic zbyt szalonego, ale teraz nie aktualizuje się, gdy zmieniam tekst w B1. Czy ktoś ma jakieś pomysły?

Prywatny Sub Worksheet_Change (ByVal Target As Range)
'test
Przyciemnij xPTable jako tabelę przestawną
Dim xPFile jako PivotField
Dim xStr jako ciąg

Dim x2PTable jako tabela przestawna
Dim x2PFFile As PivotField
Dim x2Str jako ciąg

Dim x3PTable jako tabela przestawna
Dim x3PFFile As PivotField
Dim x3Str jako ciąg

On Error Resume Next
Jeśli przecięcie(cel, zakres("b1")) jest niczym, to zakończ Sub

Application.ScreenUpdating = Fałsz

'tbl-1'
Ustaw xPTable = Worksheets("Raport liniowy").PivotTables("PivotTable7")
Ustaw xPFile = xPTable.PivotFields("Źródło Utopii")
xStr = Cel.Tekst
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr

'tbl-2'
Ustaw x2PTable = Worksheets("Raport liniowy").PivotTables("PivotTable2")
Ustaw x2PFile = x2PTable.PivotFields("Źródło Utopii")
x2Str = Cel.Tekst
x2PFile. Wyczyść wszystkie filtry
x2PFile.CurrentPage = x2Str

'tbl-3'
Ustaw x3PTable = Worksheets("Raport liniowy").PivotTables("PivotTable3")
Ustaw x3PFile = x3PTable.PivotFields("Źródło Utopii")
x3Str = Cel.Tekst
x3PFile. Wyczyść wszystkie filtry
x3PFile.CurrentPage = x3Str

Application.ScreenUpdating = True

End Sub
Ten komentarz został zminimalizowany przez moderatora na stronie
Cześć Lance,
Przetestowałem Twój kod i w moim przypadku działa dobrze. Zmiana formatu komórki nie wpływa na działanie kodu.
Ten komentarz został zminimalizowany przez moderatora na stronie
Jak działa z dodatkiem Power Pivot w przypadku korzystania z wielu tabel? Nagrałem makro zmieniające wartość w filtrze. Wprowadzono kilka zmian, aby powyższy kod działał. Ale zgłasza błąd niezgodności typów. Nie ważne co zrobię.
Ten komentarz został zminimalizowany przez moderatora na stronie
Cześć DK,
Metoda nie działa w przypadku dodatku Power Pivot. Przepraszam za niedogodności.
Ten komentarz został zminimalizowany przez moderatora na stronie
Witam,
Dziękuję bardzo za te wyjaśnienia.

J'aimerai utiliser un filtre (1 cellule) en F4 par exemple qui filtrerait deux TCD qui sont sur la même feuille.

Cela fonctionne très bien avec un TCD mais dès que j'essaye de Combiner le Second, ça ne marche pas.
Czy możesz mi pomóc

Dziękuję bardzo
Ambroży
Ten komentarz został zminimalizowany przez moderatora na stronie
Witam,

Merci beaucoup pour cette explication qui marche parfaitement.
En revanche, j'aimerais pouvoir utiliser ce code pour pouvoir filtrer deux tableaux croisés dynamiques en meme temps qui sont sur la meme feuille. La seule petite différence entre les deux, c'est qu'ils n'utilisent pas les memes sources. En revanche, le filtre sur lequel se base ces TDC est le même.

Pourriez-vous m'aider à faire évoluer ce code afin que cela fonctionne?

Voici le code utilisé quand il marche avec un TCD :

Prywatny Sub Worksheet_Change (ByVal Target As Range)
'Aktualizuj do Extendoffice 20180702
Przyciemnij xPTable jako tabelę przestawną
Dim xPFile jako PivotField
Dim xStr jako ciąg
On Error Resume Next
Jeśli przecięcie(cel, zakres("G4")) jest niczym, to zakończ Sub
Application.ScreenUpdating = Fałsz
Set xPTable = Worksheets("Cadrage").PivotTables("Tableau croisé dynamicique7")
Ustaw xPFile = xPTable.PivotFields("NR PROJEKTU")
xStr = Cel.Tekst
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr
Application.ScreenUpdating = True
End Sub

Dziękuję bardzo
Ten komentarz został zminimalizowany przez moderatora na stronie
Cześć Ambroży,

Przepraszamy, trudno jest zmienić ten kod, aby spełniał Twoje potrzeby. Jeśli chcesz filtrować wiele tabel przestawnych za pomocą jednego filtra, metody opisane w tym artykule poniżej mogą Ci pomóc:
Jak podłączyć pojedynczy fragmentator do wielu tabel przestawnych w programie Excel?
Nie ma tu jeszcze żadnych komentarzy
Zostaw swój komentarz
Publikowanie jako gość
×
Oceń ten post:
0   Postacie
Sugerowane lokalizacje

Bądż na bieżąco

Prawa autorskie © 2009 - www.extendoffice.com. | Wszelkie prawa zastrzeżone. Zasilany przez ExtendOffice, | Mapa strony
Microsoft i logo Office są znakami towarowymi lub zastrzeżonymi znakami towarowymi Microsoft Corporation w Stanach Zjednoczonych i / lub innych krajach.
Chronione przez Sectigo SSL