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

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.
kte lap 201905

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!
officetab alja
A megjegyzések rendezése szerint
Hozzászólások (23)
Még nincs értékelés. Legyen Ön az első, aki értékel!
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?)
A weboldal moderátora ezt a megjegyzést minimalizálta
Hogyan csinálná ezt egy hierarchiával rendelkező jelentésszűrővel?
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!
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
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
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
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
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
A weboldal moderátora ezt a megjegyzést minimalizálta
Szia Heather, találtál megoldást? nekem is ugyanez a problémám.
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
A weboldal moderátora ezt a megjegyzést minimalizálta
Ez lehetséges a google lapokkal? Ha igen, hogyan?
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
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
A weboldal moderátora ezt a megjegyzést minimalizálta
Olá, gostaria de saber se quisesse filtrar mais de uma categoria como poderia ser?
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
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
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
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.
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.
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.
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
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
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?
Még senki sem írt megjegyzést
Hagyja meg észrevételeit
Feladás vendégként
×
Értékeld ezt a bejegyzést:
0   Karakterek
Javasolt helyek

Kövess minket

Copyright © 2009 - www.extendoffice.com. | Minden jog fenntartva. Powered by ExtendOffice. | Oldaltérkép
A Microsoft és az Office logó a Microsoft Corporation védjegyei vagy bejegyzett védjegyei az Egyesült Államokban és / vagy más országokban.
Sectigo SSL védi