Note: The other languages of the website are Google-translated. Back to English
Vpiši se Registracija

Kako filtrirati vrtilno tabelo na podlagi določene vrednosti celice v Excelu?

Običajno podatke v vrtilni tabeli filtriramo tako, da na spustnem seznamu izberemo elemente, kot je prikazano na spodnjem posnetku zaslona. Pravzaprav lahko vrtilno tabelo filtrirate glede na vrednost v določeni celici. Metoda VBA v tem članku vam bo pomagala rešiti težavo.

Filtriraj vrtilno tabelo na podlagi določene vrednosti celice s kodo VBA

Filtriraj vrtilno tabelo na podlagi določene vrednosti celice s kodo VBA

Naslednja koda VBA vam lahko pomaga filtrirati vrtilno tabelo na podlagi določene vrednosti celice v Excelu. Naredite naslednje.

1. Vnesite vrednost, na podlagi katere boste pivot tabelo filtrirali v celico vnaprej (tukaj izberem celico H6).

2. Odprite delovni list, ki vsebuje vrtilno tabelo, ki jo boste filtrirali po vrednosti celice. Nato z desno miškino tipko kliknite zavihek lista in v kontekstnem meniju izberite Prikaži kodo. Oglejte si posnetek zaslona:

3. Na odprtju Microsoft Visual Basic za aplikacije okno, kopirajte pod kodo VBA v okno Code.

Koda VBA: Filtriraj vrtilno tabelo na podlagi vrednosti celice

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

Opombe: V kodi,

1) "Sheet1"Je ime delovnega lista.
2) "Vrtilna tabela2"Je ime vrtilne tabele.
3) Polje za filtriranje v vrtilni tabeli se imenuje "Kategorija".
4) Vrednost, ki jo želite filtrirati vrtilno tabelo, je postavljena v celico H6.
Zgornje vrednosti spremenljivk lahko spremenite po potrebi.

4. Pritisnite druga + Q tipke za zapiranje Microsoft Visual Basic za aplikacije okno.

Nato vrtilna tabela filtrira na podlagi vrednosti v celici H6, kot je prikazano spodaj:

Vrednost celice lahko po potrebi spremenite v druge.

Opombe: Vrednosti, ki jih vnesete v celico H6, se morajo natančno ujemati z vrednostmi na spustnem seznamu Kategorija vrtilne tabele.

Sorodni članki:

Najboljša orodja za pisarniško produktivnost

Kutools za Excel rešuje večino vaših težav in poveča vašo produktivnost za 80%

  • Ponovna uporaba: Hitro vstavite zapletene formule, grafikoni in vse, kar ste že uporabljali; Šifriraj celice z geslom; Ustvari poštni seznam in pošiljanje e-pošte ...
  • Vrstica Super Formula (enostavno urejanje več vrstic besedila in formule); Bralna postavitev (enostavno branje in urejanje velikega števila celic); Prilepite v filtrirani obseg...
  • Združi celice / vrstice / stolpce brez izgube podatkov; Vsebina razdeljenih celic; Združi podvojene vrstice / stolpce... prepreči podvojene celice; Primerjaj obsege...
  • Izberite Duplicate ali Unique Vrstice; Izberite prazne vrstice (vse celice so prazne); Super Find in Fuzzy Find v mnogih delovnih zvezkih; Naključna izbira ...
  • Natančna kopija Več celic brez spreminjanja sklica formule; Samodejno ustvarjanje referenc na več listov; Vstavi oznake, Potrditvena polja in še več ...
  • Izvleček besedila, Dodaj besedilo, Odstrani po položaju, Odstrani presledek; Ustvari in natisni vmesne seštevke strani Pretvarjanje med vsebino celic in komentarji...
  • Super filter (shranite in uporabite sheme filtrov za druge liste); Napredno razvrščanje glede na mesec / teden / dan, pogostost in drugo; Poseben filter s krepko, ležeče ...
  • Združite delovne zvezke in delovne liste; Spoji tabele na podlagi ključnih stolpcev; Razdelite podatke na več listov; Paketna pretvorba xls, xlsx in PDF...
  • Več kot 300 zmogljivih funkcij. Podpira Office / Excel 2007-2021 in 365. Podpira vse jezike. Enostavna uvedba v vašem podjetju ali organizaciji. 30-dnevna brezplačna preizkusna različica vseh funkcij. 60-dnevna garancija vračila denarja.
zavihek kte 201905

Kartica Office prinaša vmesnik z zavihki v Office in poenostavi vaše delo

  • Omogočite urejanje in branje z zavihki v Wordu, Excelu, PowerPointu, Publisher, Access, Visio in Project.
  • Odprite in ustvarite več dokumentov v novih zavihkih istega okna in ne v novih oknih.
  • Poveča vašo produktivnost za 50%in vsak dan zmanjša na stotine klikov miške za vas!
dno pisarniške mize
Komentarji (23)
Ocene še ni. Bodite prvi in ​​ocenite!
Daniel
Daniel
Ta komentar je moderator na spletnem mestu minimiziral
S to kodo (seveda posodobljeno za moje spremenljivke) se filter ob spremembi polja za trenutek spremeni v pravilnega, nato pa se skoraj takoj počisti. Poskuša ugotoviti, zakaj to počne (se sprašujete, ali ima kaj opraviti z ClearAllFilters na koncu podpore?)
Odgovori
0
0
Justin
Justin
Ta komentar je moderator na spletnem mestu minimiziral
Kako bi to naredili s filtrom poročil, ki ima hierarhijo?
Odgovori
0
0
Ignacia
Ignacia
Ta komentar je moderator na spletnem mestu minimiziral
Zdravo! Hvala za vaš makro.

Poskušal sem ga uporabiti za več kot eno vrtilno tabelo na isti strani, vendar ne deluje. Napisal sem takole:

Zasebni poddelovni list_Spremeni (ByVal Target As Range)
Dim xPTable1 kot vrtilna tabela
Zatemni xPFile1 kot vrtilno polje
Dim xStr1 kot niz
On Error Resume Next
Če Intersect(Target, Range("D7")) ni nič, potem zapustite Sub
Application.ScreenUpdating = Napačno
Nastavi xPTable1 = Delovni listi ("BUSCADOR"). Vrtilne tabele ("PV_ETAPA1")
Nastavite xPFile1 = xPTable1.PivotFields("ETAPA1")
xStr1 = Cilj.Besedilo
xPFile1.ClearAllFilters
xPFile1.Trenutna stran = xStr1
Application.ScreenUpdating = Res

Dim xPTable2 kot vrtilna tabela
Zatemni xPFile2 kot vrtilno polje
Dim xStr2 kot niz
On Error Resume Next
Če Intersect(Target, Range("G7")) ni nič, potem zapustite Sub
Application.ScreenUpdating = Napačno
Nastavi xPTable2 = Delovni listi ("BUSCADOR"). Vrtilne tabele ("PV_ETAPA2")
Nastavite xPFile2 = xPTable2.PivotFields("ETAPA2")
xStr2 = Cilj.Besedilo
xPFile2.ClearAllFilters
xPFile2.Trenutna stran = xStr2
Application.ScreenUpdating = Res

End Sub

Mogoče mi lahko pomagaš!

Hvala vnaprej!
Odgovori
0
0
michael
michael     Ignacia
Ta komentar je moderator na spletnem mestu minimiziral
Hi


hvala za makro


Poskušam isto stvar, vendar ne morem doseči, da bi delovala na 2 mizah. oba gledata v isto celico, samo 2 različni vrtilni tabeli


hvala
Odgovori
0
0
Oksana
Oksana     michael
Ta komentar je moderator na spletnem mestu minimiziral
Ime vrtilne tabele morate spremeniti. Vsaka vrtilna tabela ima drugačno ime. da to dobite, z desno tipko miške kliknite vrtilno ploščo in izberite nastavitve vrtilne tabele, ime bo na vrhu
Odgovori
0
0
Ambrose
Ambrose     Oksana
Ta komentar je moderator na spletnem mestu minimiziral
Pozdravljeni,

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

Merci
Odgovori
0
0
Aravind
Aravind
Ta komentar je moderator na spletnem mestu minimiziral
Pozdravljeni, iz neznanega razloga se ta makro po vstopu v vizualno osnovno stran sploh ne prikaže. Ne morem omogočiti/zagnati tega makra, preveril sem vse nastavitve centra za zaupanje, vendar se nič ne zgodi, prosim pomagajte mi
Odgovori
0
0
Heather
Heather
Ta komentar je moderator na spletnem mestu minimiziral
Živjo, zdi se, da tega ne morem spraviti v delo. Celica, na katero se želim sklicevati, je potegnjena iz formule – ali je zato filter ne najde, saj gleda formulo in ne vrednost, ki jo formula vrne? Že vnaprej hvala, Heather McDonagh
Odgovori
0
0
Sabrina
Sabrina     Heather
Ta komentar je moderator na spletnem mestu minimiziral
Živjo Heather, ali si našla rešitev? Imam enak problem.
Odgovori
0
0
AKTaylor
AKTaylor
Ta komentar je moderator na spletnem mestu minimiziral
Lahko sem spremenil/filtriral 3 različne vrtilne točke, ki so na istem zavihku. V svoj nabor podatkov sem dodal tudi vrstico »No Data Found«, sicer je filter pustil na »VSE«, česar nisem želel. Zgoraj je bilo v veliko pomoč, da sem si prislužil pohvale z vodstvom, zato sem želel deliti. Upoštevajte, da je (Vse) občutljivo na velike in male črke, da sem to ugotovil.
Zasebni poddelovni list_Spremeni (ByVal Target As Range)
'test
Dim xPTable kot vrtilna tabela
Zatemni xPFile kot vrtilno polje
Dim xStr kot niz

Dim x2PTable kot vrtilna tabela
Dim x2PFile kot vrtilno polje
Dim x2Str kot niz

Dim x3PTable kot vrtilna tabela
Dim x3PFile kot vrtilno polje
Dim x3Str kot niz

On Error Resume Next
Če Intersect(Target, Range("a2:e2")) ni nič, potem zapusti pod

Application.ScreenUpdating = Napačno

'tbl-1
Nastavi xPTable = Delovni listi ("Grafični"). Vrtilne tabele ("PivotTable1")
Nastavite xPFile = xPTable.PivotFields("Oddelek MR - Oddelek")
xStr = Target.Besedilo
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr
Če je xPFile.CurrentPage = "(Vse)", potem xPFile.CurrentPage = "Ni podatkov najti"

'tbl-2
Nastavite x2PTable = Delovni listi("Grafični").PivotTables("PivotTable2")
Nastavite x2PFile = x2PTable.PivotFields("MR Oddelek - Oddelek")
x2Str = Target.Besedilo
x2PFile.ClearAllFilters
x2PFile.CurrentPage = x2Str
Če je x2PFile.CurrentPage = "(Vse)", potem x2PFile.CurrentPage = "Ni podatkov najti"

'tbl-3
Nastavite x3PTable = Delovni listi("Grafični").PivotTables("PivotTable3")
Nastavite x3PFile = x3PTable.PivotFields("MR Oddelek - Oddelek")
x3Str = Target.Besedilo
x3PFile.ClearAllFilters
x3PFile.CurrentPage = x3Str
Če je x3PFile.CurrentPage = "(Vse)", potem x3PFile.CurrentPage = "Ni podatkov najti"

Application.ScreenUpdating = Res

End Sub
Odgovori
0
0
Drew
Drew
Ta komentar je moderator na spletnem mestu minimiziral
Ali je to mogoče z google preglednicami? Če je tako, kako?
Odgovori
0
0
Vibhor
Vibhor     Drew
Ta komentar je moderator na spletnem mestu minimiziral
Google Preglednice ne bodo zahtevale vrtilne tabele. lahko izvedete neposredno prek funkcije filtra
Odgovori
0
0
sdas34
sdas34
Ta komentar je moderator na spletnem mestu minimiziral
Na istem delovnem listu bi rad uporabil več kod za spremembo delovnega lista. Kako to narediti? Moja koda je naslednja:
Zasebni poddelovni list_Spremeni (ByVal Target As Range)
»Filter vrtilne tabele na podlagi vrednosti celice
Dim xPTable kot vrtilna tabela
Zatemni xPFile kot vrtilno polje
Dim xStr kot niz
On Error Resume Next
Če Intersect(Target, Range("D20:D21")) ni nič, potem zapustite Sub
Application.ScreenUpdating = Napačno
Nastavi xPTable = Delovni listi("List1").PivotTables("PivotTable2")
Nastavite xPFile = xPTable.PivotFields("Designation")
xStr = Target.Besedilo
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr
Application.ScreenUpdating = Res
End Sub

Zasebni pod delovni list_Change2(ByVal Target As Range)
»Filter vrtilne tabele na podlagi vrednosti celice 2
Dim xPTable kot vrtilna tabela
Zatemni xPFile kot vrtilno polje
Dim xStr kot niz
On Error Resume Next
Če Intersect(Target, Range("H20:H21")) ni nič, potem zapustite sub
Application.ScreenUpdating = Napačno
Nastavi xPTable = Delovni listi("List1").PivotTables("PivotTable2")
Nastavite xPFile = xPTable.PivotFields("ponudba")
xStr = Target.Besedilo
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr
Application.ScreenUpdating = Res
End Sub
Odgovori
poročilo
0
0
Fernando
Fernando
Ta komentar je moderator na spletnem mestu minimiziral
Olá, gostaria de saber se quisesse filtrar mais de uma categoria como poderia ser?
Odgovori
0
0
Oksana
Oksana
Ta komentar je moderator na spletnem mestu minimiziral
Kaj pa, če želim izbirno celico povezati z drugim zavihkom? To je moja koda zaenkrat
Zasebni poddelovni list_Spremeni (ByVal Target As Range)
Dim xPTable1 kot vrtilna tabela
Zatemni xPFile1 kot vrtilno polje
Dim xStr1 kot niz
On Error Resume Next
Če Intersect(Target, Range("B1")) ni nič, potem zapustite Sub
Application.ScreenUpdating = Napačno
Nastavite xPTable1 = Delovni listi("SM_SKU PIVOTS").PivotTables("PivotTable1")
Nastavite xPFile1 = xPTable1.PivotFields("Geografija")
xStr1 = Cilj.Besedilo
xPFile1.ClearAllFilters
xPFile1.Trenutna stran = xStr1
Application.ScreenUpdating = Res

Dim xPTable2 kot vrtilna tabela
Zatemni xPFile2 kot vrtilno polje
Dim xStr2 kot niz
On Error Resume Next
Če Intersect(Target, Range("B1")) ni nič, potem zapustite Sub
Application.ScreenUpdating = Napačno
Nastavite xPTable2 = Delovni listi("SM_SKU PIVOTS").PivotTables("PivotTable4")
Nastavite xPFile2 = xPTable2.PivotFields("Geografija")
xStr2 = Cilj.Besedilo
xPFile2.ClearAllFilters
xPFile2.Trenutna stran = xStr2
Application.ScreenUpdating = Res

Dim xPTable3 kot vrtilna tabela
Zatemni xPFile3 kot vrtilno polje
Dim xStr3 kot niz
On Error Resume Next
Če Intersect(Target, Range("B1")) ni nič, potem zapustite Sub
Application.ScreenUpdating = Napačno
Nastavite xPTable3 = Delovni listi("SM_SKU PIVOTS").PivotTables("PivotTable8")
Nastavite xPFile3 = xPTable3.PivotFields("Geografija")
xStr3 = Cilj.Besedilo
xPFile3.ClearAllFilters
xPFile3.Trenutna stran = xStr3
Application.ScreenUpdating = Res

End Sub
Odgovori
0
0
Alex
Alex
Ta komentar je moderator na spletnem mestu minimiziral
Zdravo!

Sem nov z VBA in rad bi imel kodo za izbiro vrtilnega filtra na podlagi obsega celic.
Kako lahko spremenim "CurrentPage" v vrednost obsega?
Hvala vam!!
-------------------------------------------------- -----------------------------------------
Sub PrintTour()

ActiveSheet.PivotTables("PivotTable1").PivotFields( _
"[Bereich 1].[Ogled].[Ogled ]"). _
ClearAllFilters
ActiveSheet.PivotTables("PivotTable1").PivotFields( _
"[Bereich 1].[Ogled].[Ogled]"). _
CurrentPage = "[Bereich 1].[Ogled lt. Anlieferungstag].&[4001-01]"
End Sub
Odgovori
0
0
kopje
kopje
Ta komentar je moderator na spletnem mestu minimiziral
Najlepša hvala za to kodo! Deloval sem, potem ko sem se prilagodil mojim poljem, vendar po formatiranju nekaterih sprememb na mojem listu zdaj ne deluje! Premaknil sem ga iz A1 v B1, spremenil nekaj oblikovanja celic, da bi izstopal itd. Nič preveč norega, vendar se zdaj ne posodobi, ko spremenim besedilo v B1. Ima kdo kakšno idejo?

Zasebni poddelovni list_Spremeni (ByVal Target As Range)
'test
Dim xPTable kot vrtilna tabela
Zatemni xPFile kot vrtilno polje
Dim xStr kot niz

Dim x2PTable kot vrtilna tabela
Dim x2PFile kot vrtilno polje
Dim x2Str kot niz

Dim x3PTable kot vrtilna tabela
Dim x3PFile kot vrtilno polje
Dim x3Str kot niz

On Error Resume Next
Če Intersect(Target, Range("b1")) ni nič, potem zapustite Sub

Application.ScreenUpdating = Napačno

'tbl-1
Nastavite xPTable = Worksheets("Line Report").Vrtilne tabele("PivotTable7")
Nastavi xPFile = xPTable.PivotFields("Utopia Source")
xStr = Target.Besedilo
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr

'tbl-2
Nastavite x2PTable = Worksheets("Line Report").Vrtilne tabele("PivotTable2")
Nastavite x2PFile = x2PTable.PivotFields("Utopia Source")
x2Str = Target.Besedilo
x2PFile.ClearAllFilters
x2PFile.CurrentPage = x2Str

'tbl-3
Nastavite x3PTable = Worksheets("Line Report").Vrtilne tabele("PivotTable3")
Nastavite x3PFile = x3PTable.PivotFields("Utopia Source")
x3Str = Target.Besedilo
x3PFile.ClearAllFilters
x3PFile.CurrentPage = x3Str

Application.ScreenUpdating = Res

End Sub
Odgovori
0
0
kristal
kristal     kopje
Ta komentar je moderator na spletnem mestu minimiziral
Živjo Lance,
Preizkusil sem vašo kodo in v mojem primeru dobro deluje. Spreminjanje formata celice ne vpliva na delovanje kode.
Odgovori
poročilo
0
0
DK
DK
Ta komentar je moderator na spletnem mestu minimiziral
Kako deluje s Power Pivotom pri uporabi več tabel? Posnel sem makro, ki spreminja vrednost v filtru. Naredili smo nekaj sprememb, da je zgornja koda delovala. Vendar sproži napako neujemanja vrste. Ne glede na to, kaj počnem.
Odgovori
0
0
kristal
kristal     DK
Ta komentar je moderator na spletnem mestu minimiziral
Živjo DK,
Metoda ne deluje za Power Pivot. Oprostite za nevšečnosti.
Odgovori
poročilo
0
0
Ambrose
Ambrose
Ta komentar je moderator na spletnem mestu minimiziral
Pozdravljeni,
Najlepša hvala za ta pojasnila.

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.
Pourriez-vous m'aider ?

Najlepša hvala
Ambrose
Odgovori
0
0
Ambrose
Ambrose
Ta komentar je moderator na spletnem mestu minimiziral
Pozdravljeni,

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 même temps qui sont sur la même feuille. La seule petite différence entre les deux, c'est qu'ils n'utilisent pas les mêmes 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 :

Zasebni poddelovni list_Spremeni (ByVal Target As Range)
'Posodobite do Extendoffice 20180702
Dim xPTable kot vrtilna tabela
Zatemni xPFile kot vrtilno polje
Dim xStr kot niz
On Error Resume Next
Če Intersect(Target, Range("G4")) ni nič, potem zapustite Sub
Application.ScreenUpdating = Napačno
Nastavite xPTable = Worksheets("Cadrage").PivotTables("Tableau croisé dynamique7")
Nastavite xPFile = xPTable.PivotFields("N°PROJET")
xStr = Target.Besedilo
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr
Application.ScreenUpdating = Res
End Sub

Najlepša hvala
Odgovori
0
0
kristal
kristal     Ambrose
Ta komentar je moderator na spletnem mestu minimiziral
Živjo Ambroise,

Žal je težko spremeniti to kodo, da bo ustrezala vašim potrebam. Če želite filtrirati več vrtilnih tabel z enim filtrom, vam bodo metode v tem članku morda koristile:
Kako povezati en rezalnik z več vrtilnimi tabelami v Excelu?
Odgovori
poročilo
0
0
Tu še ni objavljenih komentarjev
Pustite vaše komentarje
Gost
Objava kot gost
Prijava
×
Ocenite to objavo:
Ponastavi
0   Znaki
Predlagane lokacije

Sledi nam

Copyright © 2009 - www.extendoffice.com. | Vse pravice pridržane. Poganja ga ExtendOffice. | Kazalo
Microsoft in logotip Office sta blagovni znamki ali registrirani blagovni znamki družbe Microsoft Corporation v ZDA in / ali drugih državah.
Zaščiteno s Sectigo SSL