Hogyan szűrhető a Pivot-tábla egy adott cellaérték alapján az Excelben?

Általában egy kimutatástáblázatban szűrjük az adatokat a legördülő lista elemeinek kiválasztásával, az alábbi képernyőképen látható módon. Valójában szűrhet egy kimutatástáblát egy adott cellában lévő érték alapján. A cikkben szereplő VBA-módszer segít a probléma megoldásában.

Szűrje a kimutatási táblázatot egy VBA kóddal ellátott cellaérték alapján

Szűrje a kimutatási táblázatot egy VBA kóddal ellátott cellaérték alapján

A következő VBA-kód segíthet egy pivot-tábla szűrésében az Excel adott cellája alapján. Kérjük, tegye a következőket.

1. Kérjük, előzetesen írjon be egy cellába egy értéket, amely alapján a Pivot Table-t szűrni fogja (itt a H6 cellát választom).

2. Nyissa meg a pivot táblázatot tartalmazó munkalapot, amelyet cellaérték alapján szűr. Ezután kattintson a jobb gombbal a lap fülre, és válassza a helyi menü Kód megtekintése parancsát. Lásd a képernyőképet:

3. A nyílásban Microsoft Visual Basic for Applications ablakba, másolja a VBA kód alatt a Kód ablakba.

VBA kód: Szűrés kimutatási tábla a cella értéke alapján

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

Megjegyzések: A kódban

1) "Sheet1”A munkalap neve.

2) "PivotTable2”A Pivot tábla neve.

3) A pivot tábla szűrőmezője a következő:Kategória".

4) A pivot táblát szűrni kívánt érték a cellába kerül H6.

Szükség szerint megváltoztathatja a fenti változó értékeket.

4. megnyomni a más + Q gombok a Microsoft Visual Basic for Applications ablak.

Ezután a Pivot tábla a H6 cellában lévő érték alapján szűr, az alábbi képernyőképen:

Szükség szerint megváltoztathatja a cella értékét másokra.

Megjegyzések: A H6 cellába beírt értékeknek pontosan meg kell egyezniük a kimutatás táblázat kategória legördülő listájának értékeivel.

Kapcsolódó cikkek:

A legjobb irodai termelékenységi eszközök

A Kutools for Excel megoldja a legtöbb problémát, és 80% -kal növeli a termelékenységet

újrafelhasználás: Gyorsan helyezze be összetett képletek, diagramok és bármi, amit korábban használt; Cellák titkosítása jelszóval; Levelezőlista létrehozása és e-maileket küldeni ...
Szuper Formula Bár (könnyedén szerkeszthet több szöveget és képletet); Olvasás elrendezés (könnyen olvasható és szerkeszthető nagyszámú cella); Beillesztés a Szűrt tartományba...
Cellák / sorok / oszlopok egyesítése az adatok elvesztése nélkül; Osztott cellák tartalma; Kombinálja a duplikált sorokat / oszlopokat... megakadályozza az ismétlődő cellákat; Hasonlítsa össze a tartományokat...
Válassza a Másolat vagy az Egyedi lehetőséget Sorok; Válassza az Üres sorok lehetőséget (az összes cella üres); Super Find és Fuzzy Find sok munkafüzetben; Véletlenszerű kiválasztás ...
Pontos másolás Több cella a képletreferencia megváltoztatása nélkül; Automatikus referenciák létrehozása több lapra; Helyezze be a golyókat, Jelölőnégyzetek és még sok más ...
Kivonat szöveg, Szöveg hozzáadása, Eltávolítás pozíció szerint, Hely eltávolítása; Hozz létre és nyomtasson személyhívó részösszegeket; Konvertálás a cellatartalom és a megjegyzések között...
Szuper szűrő (mentse el és alkalmazza a szűrősémákat más lapokra); Haladó rendezés hónap / hét / nap, gyakoriság és egyebek szerint; Speciális szűrő félkövér, dőlt betűvel ...
Kombinálja a munkafüzeteket és a munkalapokat; Táblázatok egyesítése kulcsoszlopok alapján; Az adatok felosztása több lapra; Kötegelt konvertálás xls, xlsx és PDF...
Több mint 300 hatékony funkció. Támogatja az Office / Excel 2007-2021 és 365 verziókat. Minden nyelvet támogat. Könnyű üzembe helyezés vállalatában vagy szervezetében. Teljes funkciók 30 napos ingyenes próbaverzió. 60 napos pénzvisszafizetési garancia.

Tovább ... Ingyenes letöltés... Vásárlás...

Az Office fül a füles felületet hozza az Office-ba, és sokkal könnyebbé teszi a munkáját

Füles szerkesztés és olvasás engedélyezése Wordben, Excelben és PowerPointban, Publisher, Access, Visio és Project.
Több dokumentum megnyitása és létrehozása ugyanazon ablak új lapjain, mint új ablakokban.
50% -kal növeli a termelékenységet, és naponta több száz kattintással csökkenti az egér kattintását!

Tovább ... Ingyenes letöltés... Vásárlás...

Hozzászólások (23)

Még nincs értékelés. Legyen Ön az első, aki értékel!

Daniel

körülbelül 4 éve

#25756

A weboldal moderátora ezt a megjegyzést minimalizálta

Ezzel a kóddal (természetesen a változóimhoz frissítve) a mező megváltoztatásakor a szűrő egy pillanatra átvált a megfelelőre, majd szinte azonnal törli magát. Megpróbálja kitalálni, hogy miért csinálja ezt (az a kérdés, hogy van-e valami köze az alrész végén található ClearAllFilters-hez?)

Válasz

Justin

körülbelül 4 éve

#26177

A weboldal moderátora ezt a megjegyzést minimalizálta

Hogyan csinálná ezt egy hierarchiával rendelkező jelentésszűrővel?

Válasz

Ignácia

körülbelül 3 éve

#30976

A weboldal moderátora ezt a megjegyzést minimalizálta

Hé! Köszönöm a makrót.

Próbáltam egynél több pivot táblához használni ugyanazon az oldalon, de nem működik. így írtam:

Private Sub Worksheet_Change (ByVal Target mint Range)
Dim xPTable1 PivotTable-ként
Dim xPFile1 PivotFieldként
Dim xStr1 As String
On Error Resume Next
Ha a metszéspont(cél, tartomány("D7")) semmi, akkor lépjen ki a Sub
Application.ScreenUpdating = Hamis
Set xPTable1 = Munkalapok("BUSCADOR").PivotTables("PV_ETAPA1")
Állítsa be az xPFile1 = xPTable1.PivotFields("ETAPA1")
xStr1 = Cél.Szöveg
xPFile1.ClearAllFilters
xPFile1.CurrentPage = xStr1
Application.ScreenUpdating = Igaz

Dim xPTable2 PivotTable-ként
Dim xPFile2 PivotFieldként
Dim xStr2 As String
On Error Resume Next
Ha a metszéspont(cél, tartomány("G7")) semmi, akkor lépjen ki az alból
Application.ScreenUpdating = Hamis
Set xPTable2 = Munkalapok("BUSCADOR").PivotTables("PV_ETAPA2")
Állítsa be az xPFile2 = xPTable2.PivotFields("ETAPA2")
xStr2 = Cél.Szöveg
xPFile2.ClearAllFilters
xPFile2.CurrentPage = xStr2
Application.ScreenUpdating = Igaz

End Sub

Talán tudsz nekem segíteni!

Előre is köszönöm!

Válasz

Michael Ignácia

körülbelül 2 éve

#30977

A weboldal moderátora ezt a megjegyzést minimalizálta

Hi

köszi a makrót

Ugyanezt próbálom, de nem tudom 2 asztalon működni. mindketten ugyanazt a cellát nézik, csak 2 különböző pivot táblát

köszönöm

Válasz

Oksana Michael

mintegy 1 éve

#30978

A weboldal moderátora ezt a megjegyzést minimalizálta

Módosítania kell a Pivot Table nevét. Minden kimutatástáblának más a neve. ennek eléréséhez kattintson a jobb gombbal a pivotra, és válassza ki a pivot table beállításokat, a név fent lesz

Válasz

Ambrose Oksana

kb 1 hónapja

#42326

A weboldal moderátora ezt a megjegyzést minimalizálta

Jó napot,

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

Válasz

Aravind

körülbelül 2 éve

#32775

A weboldal moderátora ezt a megjegyzést minimalizálta

Hello, valamiért ez a makró a Visual Basic oldalra való belépés után egyáltalán nem jelenik meg. Nem tudom engedélyezni/futtatni ezt a makrót, ellenőriztem az összes bizalmi központ beállítást, de nem történik semmi, kérlek segíts

Válasz

Hanga

körülbelül 2 éve

#33165

A weboldal moderátora ezt a megjegyzést minimalizálta

Szia, úgy tűnik, nem tudom működni. Az a cella, amelyre hivatkozni akarok, egy képletből van behúzva – ez az oka annak, hogy a szűrő nem találja meg, mivel a képletet nézi, nem pedig a képlet által visszaadott értéket? Előre is köszönöm Heather McDonagh

Válasz

Sabrina Hanga

mintegy 1 éve

#33166

A weboldal moderátora ezt a megjegyzést minimalizálta

Szia Heather, találtál megoldást? nekem is ugyanez a problémám.

Válasz

AKTaylor

körülbelül 2 éve

#33770

A weboldal moderátora ezt a megjegyzést minimalizálta

Sikerült módosítani/szűrni 3 különböző pivotot, amelyek ugyanazon a lapon vannak. Hozzáadtam egy sort is az adatkészletemhez "No Data Found", különben a szűrőt "ALL"-ra hagyta, amit nem akartam. A fentiek nagy segítségemre voltak abban, hogy dicséretet kaptam a vezetőségtől, ezért meg akartam osztani. Ne feledje, hogy a (Minden) kis- és nagybetűk megkülönböztetése miatt rájöttem egy kicsit.
Private Sub Worksheet_Change (ByVal Target mint Range)
'teszt
Dim xPTable PivotTable-ként
Dim xPFile PivotFieldként
Dim xStr As String

Dim x2PTable PivotTable-ként
Dim x2PFile PivotField-ként
Dim x2Str As String

Dim x3PTable PivotTable-ként
Dim x3PFile PivotField-ként
Dim x3Str As String

On Error Resume Next
Ha a metszéspont(cél, tartomány("a2:e2")) semmi, akkor lépjen ki a Sub

Application.ScreenUpdating = Hamis

'tbl-1
Set xPTable = Worksheets("Grafikus").PivotTables("PivotTable1")
Állítsa be az xPFile = xPTable.PivotFields("MR osztály - Osztály")
xStr = Target.Text
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr
Ha xPFile.CurrentPage = "(Mind)", akkor xPFile.CurrentPage = "Nem található adat"

'tbl-2
Set x2PTable = Munkalapok("Grafikus").PivotTables("PivotTable2")
Állítsa be az x2PFile = x2PTable.PivotFields("MR osztály - Osztály")
x2Str = Cél.Szöveg
x2PFile.ClearAllFilters
x2PFile.CurrentPage = x2Str
Ha x2PFile.CurrentPage = "(Mind)", akkor x2PFile.CurrentPage = "Nem található adat"

'tbl-3
Set x3PTable = Munkalapok("Grafikus").PivotTables("PivotTable3")
Állítsa be az x3PFile = x3PTable.PivotFields("MR osztály - Osztály")
x3Str = Cél.Szöveg
x3PFile.ClearAllFilters
x3PFile.CurrentPage = x3Str
Ha x3PFile.CurrentPage = "(Mind)", akkor x3PFile.CurrentPage = "Nem található adat"

Application.ScreenUpdating = Igaz

End Sub

Válasz

Drew

körülbelül 2 éve

#34435

A weboldal moderátora ezt a megjegyzést minimalizálta

Ez lehetséges a google lapokkal? Ha igen, hogyan?

Válasz

Vibhor Drew

mintegy 1 éve

#34436

A weboldal moderátora ezt a megjegyzést minimalizálta

A Google Táblázatok nem igényel kimutatást. közvetlenül végrehajthatja a szűrőfunkción keresztül

Válasz

sdas34

körülbelül 2 éve

#34609

A weboldal moderátora ezt a megjegyzést minimalizálta

Több munkalap-módosítási kódot szeretnék használni ugyanazon a munkalapon. Hogyan kell csinálni? A kódom a következő:
Private Sub Worksheet_Change (ByVal Target mint Range)
'Pivot tábla szűrő cellaérték alapján
Dim xPTable PivotTable-ként
Dim xPFile PivotFieldként
Dim xStr As String
On Error Resume Next
Ha a metszéspont(cél, tartomány("D20:D21")) semmi, akkor lépjen ki az alból
Application.ScreenUpdating = Hamis
Set xPTable = Worksheets("Sheet1").PivotTables("PivotTable2")
Állítsa be az xPFile = xPTable.PivotFields("Megjelölés")
xStr = Target.Text
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr
Application.ScreenUpdating = Igaz
End Sub

Private Sub Worksheet_Change2 (ByVal Target as Range)
„Pivot table szűrő a 2. cellaérték alapján
Dim xPTable PivotTable-ként
Dim xPFile PivotFieldként
Dim xStr As String
On Error Resume Next
Ha a metszéspont(cél, tartomány("H20:H21")) semmi, akkor lépjen ki a részből
Application.ScreenUpdating = Hamis
Set xPTable = Worksheets("Sheet1").PivotTables("PivotTable2")
Állítsa be az xPFile = xPTable.PivotFields("Offering")
xStr = Target.Text
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr
Application.ScreenUpdating = Igaz
End Sub

Válasz

Jelentés

Fernando

mintegy 1 éve

#35024

A weboldal moderátora ezt a megjegyzést minimalizálta

Olá, gostaria de saber se quisesse filtrar mais de uma categoria como poderia ser?

Válasz

Oksana

mintegy 1 éve

#35785

A weboldal moderátora ezt a megjegyzést minimalizálta

Mi a teendő, ha a kijelölő cellát egy másik laphoz szeretném kapcsolni? Eddig ez a kódom
Private Sub Worksheet_Change (ByVal Target mint Range)
Dim xPTable1 PivotTable-ként
Dim xPFile1 PivotFieldként
Dim xStr1 As String
On Error Resume Next
Ha a metszéspont(cél, tartomány("B1")) semmi, akkor lépjen ki az alból
Application.ScreenUpdating = Hamis
Set xPTable1 = Munkalapok("SM_SKU PIVOTS").PivotTables("PivotTable1")
Állítsa be az xPFile1 = xPTable1.PivotFields("Földrajz")
xStr1 = Cél.Szöveg
xPFile1.ClearAllFilters
xPFile1.CurrentPage = xStr1
Application.ScreenUpdating = Igaz

Dim xPTable2 PivotTable-ként
Dim xPFile2 PivotFieldként
Dim xStr2 As String
On Error Resume Next
Ha a metszéspont(cél, tartomány("B1")) semmi, akkor lépjen ki az alból
Application.ScreenUpdating = Hamis
Set xPTable2 = Munkalapok("SM_SKU PIVOTS").PivotTables("PivotTable4")
Állítsa be az xPFile2 = xPTable2.PivotFields("Földrajz")
xStr2 = Cél.Szöveg
xPFile2.ClearAllFilters
xPFile2.CurrentPage = xStr2
Application.ScreenUpdating = Igaz

Dim xPTable3 PivotTable-ként
Dim xPFile3 PivotFieldként
Dim xStr3 As String
On Error Resume Next
Ha a metszéspont(cél, tartomány("B1")) semmi, akkor lépjen ki az alból
Application.ScreenUpdating = Hamis
Set xPTable3 = Munkalapok("SM_SKU PIVOTS").PivotTables("PivotTable8")
Állítsa be az xPFile3 = xPTable3.PivotFields("Földrajz")
xStr3 = Cél.Szöveg
xPFile3.ClearAllFilters
xPFile3.CurrentPage = xStr3
Application.ScreenUpdating = Igaz

End Sub

Válasz

Alex

mintegy 7 hónappal ezelőtt

#38505

A weboldal moderátora ezt a megjegyzést minimalizálta

Helló!

Új vagyok a VBA-ban, és szeretnék egy kódot a pivot szűrő kiválasztásához cellatartomány alapján.
Hogyan változtathatom meg a "CurrentPage"-t tartományértékké?
Köszönöm!!
-------------------------------------------------- -----------------------------------------
Sub Print Tour()

ActiveSheet.PivotTables("PivotTable1").PivotFields(_
"[Bereich 1].[Túra].[Túra ]"). _
ClearAllFilters
ActiveSheet.PivotTables("PivotTable1").PivotFields(_
"[Bereich 1].[Túra].[Túra]"). _
CurrentPage = "[Bereich 1].[Tour lt. Anlieferungstag].&[4001-01]"
End Sub

Válasz

dob

mintegy 7 hónappal ezelőtt

#38840

A weboldal moderátora ezt a megjegyzést minimalizálta

Köszönöm szépen ezt a kódot! A mezőimnek megfelelő beállítás után működött, de néhány változtatás után a lapomon most nem működik! Áthelyeztem A1-ről B1-re, módosítottam néhány cellaformázást, hogy feltűnjön, stb. Semmi őrültség, de most nem frissül, ha szöveget módosítok a B1-ben. Van valakinek valami ötlete?

Private Sub Worksheet_Change (ByVal Target mint Range)
'teszt
Dim xPTable PivotTable-ként
Dim xPFile PivotFieldként
Dim xStr As String

Dim x2PTable PivotTable-ként
Dim x2PFile PivotField-ként
Dim x2Str As String

Dim x3PTable PivotTable-ként
Dim x3PFile PivotField-ként
Dim x3Str As String

On Error Resume Next
Ha a metszéspont(cél, tartomány("b1")) semmi, akkor lépjen ki az alból

Application.ScreenUpdating = Hamis

'tbl-1
Set xPTable = Munkalapok("Sorjelentés").PivotTables("PivotTable7")
Állítsa be az xPFile = xPTable.PivotFields("Utópiaforrás")
xStr = Target.Text
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr

'tbl-2
Set x2PTable = Munkalapok("Sorjelentés").PivotTables("PivotTable2")
Állítsa be az x2PFile = x2PTable.PivotFields("Utópiaforrás")
x2Str = Cél.Szöveg
x2PFile.ClearAllFilters
x2PFile.CurrentPage = x2Str

'tbl-3
Set x3PTable = Munkalapok("Sorjelentés").PivotTables("PivotTable3")
Állítsa be az x3PFile = x3PTable.PivotFields("Utópiaforrás")
x3Str = Cél.Szöveg
x3PFile.ClearAllFilters
x3PFile.CurrentPage = x3Str

Application.ScreenUpdating = Igaz

End Sub

Válasz

kristály- dob

mintegy 6 hónappal ezelőtt

#38901

A weboldal moderátora ezt a megjegyzést minimalizálta

Szia Lance,
Kipróbáltam a kódodat, és az én esetemben jól működik. A cellaformátum megváltoztatása nem befolyásolja a kód működését.

Válasz

Jelentés

mintegy 5 hónappal ezelőtt

#39652

A weboldal moderátora ezt a megjegyzést minimalizálta

Hogyan működik a Power Pivot több tábla használata esetén? Felvettem a makrót, amely megváltoztatja az értéket a szűrőben. Néhány változtatást hajtott végre, hogy a fenti kód működjön. De Type mismatch hibát dob. Nem számít mit csinálok.

Válasz

kristály- DK

mintegy 5 hónappal ezelőtt

#39718

A weboldal moderátora ezt a megjegyzést minimalizálta

Szia DK,
A módszer nem működik a Power Pivot esetében. Elnézést a kellemetlenségért.

Válasz

Jelentés

Ambrose

kb 1 hónapja

#42309

A weboldal moderátora ezt a megjegyzést minimalizálta

Jó napot,
Nagyon köszönöm ezeket a magyarázatokat.

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.
Tudna nekem segíteni ?

Merci beaucoup
Ambrose

Válasz

Ambrose

kb 1 hónapja

#42324

A weboldal moderátora ezt a megjegyzést minimalizálta

Jó napot,

Merci beaucoup for 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:

Private Sub Worksheet_Change (ByVal Target mint Range)
'Frissítés Extendoffice 20180702
Dim xPTable PivotTable-ként
Dim xPFile PivotFieldként
Dim xStr As String
On Error Resume Next
Ha a metszéspont(cél, tartomány("G4")) semmi, akkor lépjen ki az alból
Application.ScreenUpdating = Hamis
Set xPTable = Worksheets("Cadrage").PivotTables("Tableau croisé dynamique7")
Állítsa be az xPFile = xPTable.PivotFields("N° PROJET")
xStr = Target.Text
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr
Application.ScreenUpdating = Igaz
End Sub

Merci beaucoup

Válasz

kristály- Ambrose

kb 1 hónapja

#42387

A weboldal moderátora ezt a megjegyzést minimalizálta

Szia Ambroise,

Sajnáljuk, nehéz ezt a kódot az Ön igényeinek megfelelően módosítani. Ha több pivot táblát szeretne szűrni egyetlen szűrővel, az alábbi cikkben ismertetett módszerek jót tehetnek:
Hogyan lehet egyetlen szeletelőt több kimutatástáblázathoz csatlakoztatni az Excelben?

Válasz

Jelentés

Még senki sem írt megjegyzést

Hagyja meg észrevételeit

Feladás vendégként

Bejelentkezés

Név (kötelező)

Email (szükséges)

Értékeld ezt a bejegyzést:

vissza

0 Karakterek

Egyetértek azzal, hogy a szabályait és feltételeit