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

Jak filtrovat kontingenční tabulku na základě konkrétní hodnoty buňky v aplikaci Excel?

Normálně filtrujeme data v kontingenční tabulce výběrem položek v rozevíracím seznamu, jak je znázorněno na obrázku níže. Ve skutečnosti můžete kontingenční tabulku filtrovat na základě hodnoty v konkrétní buňce. Metoda VBA v tomto článku vám pomůže problém vyřešit.

Filtrování kontingenční tabulky na základě konkrétní hodnoty buňky pomocí kódu VBA


Filtrování kontingenční tabulky na základě konkrétní hodnoty buňky pomocí kódu VBA

Následující kód VBA vám pomůže filtrovat kontingenční tabulku na základě konkrétní hodnoty buňky v aplikaci Excel. Postupujte prosím následovně.

1. Zadejte předem hodnotu, podle které budete kontingenční tabulku filtrovat, do buňky (zde vyberu buňku H6).

2. Otevřete list obsahující kontingenční tabulku, kterou budete filtrovat podle hodnoty buňky. Poté klikněte pravým tlačítkem na kartu listu a v místní nabídce vyberte možnost Zobrazit kód. Viz snímek obrazovky:

3. V otvoru Microsoft Visual Basic pro aplikace zkopírujte níže uvedený kód VBA do okna Kód.

Kód VBA: Filtrování kontingenční tabulky na základě hodnoty buňky

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

Poznámky: V kódu,

1) "Sheet1„Je název listu.
2) "Kontingenční tabulka 2„Je název kontingenční tabulky.
3) Filtrační pole v kontingenční tabulce se nazývá „Kategorie".
4) Hodnota, kterou chcete filtrovat kontingenční tabulku, je umístěna do buňky H6.
Podle potřeby můžete výše uvedené hodnoty proměnných změnit.

4. zmáčkni Další + Q klávesy pro zavření Microsoft Visual Basic pro aplikace okno.

Poté je kontingenční tabulka filtrována na základě hodnoty v buňce H6, jak je uvedeno níže:

Hodnotu buňky můžete podle potřeby změnit na ostatní.

Poznámka: Hodnoty, které zadáte do buňky H6, by se měly přesně shodovat s hodnotami v rozevíracím seznamu Kategorie v kontingenční tabulce.


Související články:


Nejlepší kancelářské nástroje produktivity

Kutools pro Excel řeší většinu vašich problémů a zvyšuje vaši produktivitu o 80%

  • Opakované použití: Rychle vložte složité vzorce, grafy a cokoli, co jste dříve používali; Šifrovat buňky s heslem; Vytvořte seznam adresátů a posílat e-maily ...
  • Super Formula Bar (snadno upravit více řádků textu a vzorce); Rozložení pro čtení (snadno číst a upravovat velké množství buněk); Vložit do filtrovaného rozsahu...
  • Sloučit buňky / řádky / sloupce bez ztráty dat; Rozdělit obsah buněk; Zkombinujte duplicitní řádky / sloupce... Zabraňte duplicitním buňkám; Porovnat rozsahy...
  • Vyberte možnost Duplikovat nebo Jedinečný Řádky; Vyberte prázdné řádky (všechny buňky jsou prázdné); Super hledání a fuzzy hledání v mnoha sešitech; Náhodný výběr ...
  • Přesná kopie Více buněk beze změny odkazu na vzorec; Automaticky vytvářet reference do více listů; Vložte odrážky, Zaškrtávací políčka a další ...
  • Extrahujte text, Přidat text, Odebrat podle pozice, Odebrat mezeru; Vytváření a tisk mezisoučtů stránkování; Převod mezi obsahem buněk a komentáři...
  • Super filtr (uložit a použít schémata filtrů na jiné listy); Rozšířené řazení podle měsíce / týdne / dne, frekvence a dalších; Speciální filtr tučnou kurzívou ...
  • Kombinujte sešity a pracovní listy; Sloučit tabulky na základě klíčových sloupců; Rozdělte data do více listů; Dávkový převod xls, xlsx a PDF...
  • Více než 300 výkonných funkcí. Podporuje Office / Excel 2007-2021 a 365. Podporuje všechny jazyky. Snadné nasazení ve vašem podniku nebo organizaci. Plné funkce 30denní bezplatná zkušební verze. 60denní záruka vrácení peněz.
karta kte 201905

Office Tab přináší do Office rozhraní s kartami a usnadňuje vám práci

  • Povolte úpravy a čtení na kartách ve Wordu, Excelu, PowerPointu, Publisher, Access, Visio a Project.
  • Otevřete a vytvořte více dokumentů na nových kartách ve stejném okně, nikoli v nových oknech.
  • Zvyšuje vaši produktivitu o 50%a snižuje stovky kliknutí myší každý den!
officetab dno
Komentáře (23)
Zatím žádné hodnocení. Buďte první, kdo ohodnotí!
Tento komentář byl moderátorem webu minimalizován
Pomocí tohoto kódu (samozřejmě aktualizovaného pro mé proměnné) se při změně pole filtr na okamžik změní na správný a poté se téměř okamžitě vyčistí. Snažím se přijít na to, proč to dělá (zajímalo by vás, jestli to má něco společného s ClearAllFilters na konci podřízeného?)
Tento komentář byl moderátorem webu minimalizován
Jak byste to udělali s filtrem sestav, který má hierarchii?
Tento komentář byl moderátorem webu minimalizován
Ahoj! Díky za vaše makro.

Zkoušel jsem to použít pro více než jednu kontingenční tabulku na stejné stránce, ale nefunguje to. Napsal jsem to takto:

Soukromá dílčí tabulka_Změna (ByVal Target As Range)
Dim xPTable1 jako kontingenční tabulka
Dim xPFile1 jako PivotField
Dim xStr1 jako řetězec
On Error Resume Next
If Intersect(Target, Range("D7")) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Set xPTable1 = Worksheets("BUSCADOR").PivotTables("PV_ETAPA1")
Nastavit xPFile1 = xPTable1.PivotFields("ETAPA1")
xStr1 = Cíl.Text
xPFile1.ClearAllFilters
xPFile1.CurrentPage = xStr1
Application.ScreenUpdating = True

Dim xPTable2 jako kontingenční tabulka
Dim xPFile2 jako PivotField
Dim xStr2 jako řetězec
On Error Resume Next
If Intersect(Target, Range("G7")) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Set xPTable2 = Worksheets("BUSCADOR").PivotTables("PV_ETAPA2")
Nastavit xPFile2 = xPTable2.PivotFields("ETAPA2")
xStr2 = Cíl.Text
xPFile2.ClearAllFilters
xPFile2.CurrentPage = xStr2
Application.ScreenUpdating = True

End Sub

Možná mi pomůžete!

Díky předem!
Tento komentář byl moderátorem webu minimalizován
Hi


díky za Makro


Zkouším to samé, ale nemůžu to rozjet na 2 stolech. oba se dívají na stejnou buňku, jen 2 různé kontingenční tabulky


Díky
Tento komentář byl moderátorem webu minimalizován
Musíte změnit název kontingenční tabulky. Každá kontingenční tabulka má jiný název. Chcete-li to získat, klikněte pravým tlačítkem na pivot a vyberte nastavení kontingenční tabulky, název bude nahoře
Tento komentář byl moderátorem webu minimalizován
Dobrý den,

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?

děkuji
Tento komentář byl moderátorem webu minimalizován
Dobrý den, z nějakého důvodu se toto makro po vstupu na stránku Visual Basic vůbec nezobrazuje. Nemohu povolit/spustit toto makro, zkontroloval jsem všechna nastavení centra důvěry, ale nic se neděje, prosím pomozte mi
Tento komentář byl moderátorem webu minimalizován
Ahoj, nějak se mi to nedaří zprovoznit. Buňka, na kterou se chci odkazovat, je vtažena ze vzorce – proto ji filtr nemůže najít, protože se dívá na vzorec a ne na hodnotu, kterou vzorec vrací? Předem děkujiHeather McDonagh
Tento komentář byl moderátorem webu minimalizován
Ahoj Heather, našla jsi řešení. Mám úplně stejný problém.
Tento komentář byl moderátorem webu minimalizován
Byl jsem schopen upravit/filtrovat 3 různé pivoty, které jsou na stejné kartě. Také jsem přidal řádek do své datové sady „Žádná data nenalezena“, jinak to nechalo filtr na „ALL“, což jsem nechtěl. Výše uvedené bylo velkým přínosem pro získání chvály s vedením, takže jsem se chtěl podělit. Všimněte si, že (vše) rozlišuje malá a velká písmena, než jsem na to přišel.
Soukromá dílčí tabulka_Změna (ByVal Target As Range)
'test
Dim xPTable jako kontingenční tabulka
Dim xPFile As PivotField
Dim xStr jako řetězec

Dim x2PTable jako kontingenční tabulka
Dim x2PFile As PivotField
Dim x2Str jako řetězec

Dim x3PTable jako kontingenční tabulka
Dim x3PFile As PivotField
Dim x3Str jako řetězec

On Error Resume Next
If Intersect(Target, Range("a2:e2")) Is Nothing Then Exit Sub

Application.ScreenUpdating = False

'tbl-1
Set xPTable = Worksheets("Graphical").PivotTables("PivotTable1")
Nastavit xPFile = xPTable.PivotFields("MR oddělení - oddělení")
xStr = Target.Text
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr
If xPFile.CurrentPage = "(All)" Then xPFile.CurrentPage = "Nebyla nalezena žádná data"

'tbl-2
Set x2PTable = Worksheets("Graphical").PivotTables("PivotTable2")
Set x2PFile = x2PTable.PivotFields("MR oddělení - oddělení")
x2Str = Cíl.Text
x2PFile.ClearAllFilters
x2PFile.CurrentPage = x2Str
If x2PFile.CurrentPage = "(Vše)" Then x2PFile.CurrentPage = "Nebyla nalezena žádná data"

'tbl-3
Set x3PTable = Worksheets("Graphical").PivotTables("PivotTable3")
Set x3PFile = x3PTable.PivotFields("MR oddělení - oddělení")
x3Str = Cíl.Text
x3PFile.ClearAllFilters
x3PFile.CurrentPage = x3Str
If x3PFile.CurrentPage = "(Vše)" Then x3PFile.CurrentPage = "Nebyla nalezena žádná data"

Application.ScreenUpdating = True

End Sub
Tento komentář byl moderátorem webu minimalizován
Je to možné pomocí google listů? Pokud ano, jak?
Tento komentář byl moderátorem webu minimalizován
Tabulky Google nebudou vyžadovat žádnou kontingenční tabulku. můžete přímo provádět pomocí funkce filtru
Tento komentář byl moderátorem webu minimalizován
Chtěl bych použít více kódu změny listu ve stejném listu. Jak to udělat? Můj kód je následující:
Soukromá dílčí tabulka_Změna (ByVal Target As Range)
'Filtr kontingenční tabulky na základě hodnoty buňky
Dim xPTable jako kontingenční tabulka
Dim xPFile As PivotField
Dim xStr jako řetězec
On Error Resume Next
If Intersect(Target, Range("D20:D21")) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Set xPTable = Worksheets("Sheet1").PivotTables("PivotTable2")
Nastavit xPFile = xPTable.PivotFields("Designation")
xStr = Target.Text
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr
Application.ScreenUpdating = True
End Sub

Private Sub Worksheet_Change2 (ByVal Target As Range)
'Filtr kontingenční tabulky na základě hodnoty buňky 2
Dim xPTable jako kontingenční tabulka
Dim xPFile As PivotField
Dim xStr jako řetězec
On Error Resume Next
If Intersect(Target, Range("H20:H21")) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Set xPTable = Worksheets("Sheet1").PivotTables("PivotTable2")
Nastavit xPFile = xPTable.PivotFields("Nabídka")
xStr = Target.Text
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr
Application.ScreenUpdating = True
End Sub
Tento komentář byl moderátorem webu minimalizován
Olá, gostaria de saber se quisesse filtrar mais de uma categoria como poderia ser?
Tento komentář byl moderátorem webu minimalizován
Co když chci propojit výběrovou buňku s jinou kartou? Toto je zatím můj kód
Soukromá dílčí tabulka_Změna (ByVal Target As Range)
Dim xPTable1 jako kontingenční tabulka
Dim xPFile1 jako PivotField
Dim xStr1 jako řetězec
On Error Resume Next
If Intersect(Target, Range("B1")) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Set xPTable1 = Worksheets("SM_SKU PIVOTS").PivotTables("PivotTable1")
Nastavit xPFile1 = xPTable1.PivotFields("Geography")
xStr1 = Cíl.Text
xPFile1.ClearAllFilters
xPFile1.CurrentPage = xStr1
Application.ScreenUpdating = True

Dim xPTable2 jako kontingenční tabulka
Dim xPFile2 jako PivotField
Dim xStr2 jako řetězec
On Error Resume Next
If Intersect(Target, Range("B1")) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Set xPTable2 = Worksheets("SM_SKU PIVOTS").PivotTables("PivotTable4")
Nastavit xPFile2 = xPTable2.PivotFields("Geography")
xStr2 = Cíl.Text
xPFile2.ClearAllFilters
xPFile2.CurrentPage = xStr2
Application.ScreenUpdating = True

Dim xPTable3 jako kontingenční tabulka
Dim xPFile3 jako PivotField
Dim xStr3 jako řetězec
On Error Resume Next
If Intersect(Target, Range("B1")) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Set xPTable3 = Worksheets("SM_SKU PIVOTS").PivotTables("PivotTable8")
Nastavit xPFile3 = xPTable3.PivotFields("Geography")
xStr3 = Cíl.Text
xPFile3.ClearAllFilters
xPFile3.CurrentPage = xStr3
Application.ScreenUpdating = True

End Sub
Tento komentář byl moderátorem webu minimalizován
Dobrý den!

Jsem nový s VBA a chtěl bych mít kód pro výběr pivotního filtru na základě rozsahu buněk.
Jak mohu změnit "CurrentPage" na hodnotu rozsahu?
Děkuji!!
-------------------------------------------------- -----------------------------------------
Sub PrintTour()

ActiveSheet.PivotTables("PivotTable1").PivotFields( _
"[Bereich 1].[Tour].[Tour ]"). _
ClearAllFilters
ActiveSheet.PivotTables("PivotTable1").PivotFields( _
"[Bereich 1].[Tour].[Tour]"). _
CurrentPage = "[Bereich 1].[Tour lt. Anlieferungstag].&[4001-01]"
End Sub
Tento komentář byl moderátorem webu minimalizován
Děkuji mnohokrát za tento kód! Po úpravě, aby vyhovovala mým polím, to funguje, ale po naformátování některých změn na mém listu to teď nefunguje! Přesunul jsem to z A1 do B1, změnil nějaké formátování buněk, aby to vyniklo atd. Nic moc šíleného, ​​ale teď se to neaktualizuje, když změním text v B1. Máte někdo nějaké nápady?

Soukromá dílčí tabulka_Změna (ByVal Target As Range)
'test
Dim xPTable jako kontingenční tabulka
Dim xPFile As PivotField
Dim xStr jako řetězec

Dim x2PTable jako kontingenční tabulka
Dim x2PFile As PivotField
Dim x2Str jako řetězec

Dim x3PTable jako kontingenční tabulka
Dim x3PFile As PivotField
Dim x3Str jako řetězec

On Error Resume Next
If Intersect(Target, Range("b1")) Is Nothing Then Exit Sub

Application.ScreenUpdating = False

'tbl-1
Set xPTable = Worksheets("Řádková sestava").PivotTables("PivotTable7")
Nastavit xPFile = xPTable.PivotFields("Zdroj utopie")
xStr = Target.Text
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr

'tbl-2
Set x2PTable = Worksheets("Řádková sestava").PivotTables("PivotTable2")
Set x2PFile = x2PTable.PivotFields("Utopia Source")
x2Str = Cíl.Text
x2PFile.ClearAllFilters
x2PFile.CurrentPage = x2Str

'tbl-3
Set x3PTable = Worksheets("Řádková sestava").PivotTables("PivotTable3")
Set x3PFile = x3PTable.PivotFields("Utopia Source")
x3Str = Cíl.Text
x3PFile.ClearAllFilters
x3PFile.CurrentPage = x3Str

Application.ScreenUpdating = True

End Sub
Tento komentář byl moderátorem webu minimalizován
ahoj Lance,
Testoval jsem váš kód a v mém případě funguje dobře. Změna formátu buňky neovlivní fungování kódu.
Tento komentář byl moderátorem webu minimalizován
Jak to funguje s Power Pivotem při použití více tabulek? Zaznamenal jsem makro měnící hodnotu ve filtru. Aby výše uvedený kód fungoval, provedli jsme několik změn. Ale vyhodí to chybu nesouladu typu. Nezáleží na tom, co dělám.
Tento komentář byl moderátorem webu minimalizován
Ahoj neví,
Tato metoda nefunguje pro Power Pivot. Omluvám se za nepříjemnost.
Tento komentář byl moderátorem webu minimalizován
Dobrý den,
Moc děkuji za tato vysvětlení.

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 Combinr le second, ça ne marche pas.
Mohl byste mi pomoct ?

Merci beaucoup
Ambrose
Tento komentář byl moderátorem webu minimalizován
Dobrý den,

Merci beaucoup pour cette explication qui marche parfaitement.
En revanche, j'aimerais pouvoir utiliser ce code pour pouvoir filterer deux tableaux croisés dynamiciques 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 ?

Používaný hlasový kód v rámci TCD:

Soukromá dílčí tabulka_Změna (ByVal Target As Range)
'Aktualizovat od Extendoffice 20180702
Dim xPTable jako kontingenční tabulka
Dim xPFile As PivotField
Dim xStr jako řetězec
On Error Resume Next
If Intersect(Target, Range("G4")) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Set xPTable = Worksheets("Cadrage").PivotTables("Tableau croisé dynamique7")
Nastavit xPFile = xPTable.PivotFields("N°PROJET")
xStr = Target.Text
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr
Application.ScreenUpdating = True
End Sub

Merci beaucoup
Tento komentář byl moderátorem webu minimalizován
Ahoj Ambroise,

Omlouváme se, je těžké upravit tento kód tak, aby vyhovoval vašim potřebám. Pokud chcete filtrovat více kontingenčních tabulek pomocí jednoho filtru, mohou vám pomoci metody v tomto článku níže:
Jak připojit jeden výřez k více kontingenčním tabulkám v Excelu?
Zatím zde nejsou žádné komentáře
Zanechat své připomínky
Odesílání jako host
×
Ohodnoťte tento příspěvek:
0   Postavy
Doporučená umístění

Sociální sítě

Copyright © 2009 - www.extendoffice.com. | Všechna práva vyhrazena. Poháněno ExtendOffice. | |. | Sitemap
Microsoft a logo Office jsou ochranné známky nebo registrované ochranné známky společnosti Microsoft Corporation ve Spojených státech a / nebo jiných zemích.
Chráněno Sectigo SSL