Hoe een draaitabel filteren op basis van een specifieke celwaarde in Excel?

Normaal gesproken filteren we gegevens in een draaitabel door items in de vervolgkeuzelijst te selecteren, zoals weergegeven in de onderstaande schermafbeelding. Eigenlijk kunt u een draaitabel filteren op basis van de waarde in een specifieke cel. De VBA-methode in dit artikel zal u helpen het probleem op te lossen.

Filter draaitabel op basis van een specifieke celwaarde met VBA-code

Filter draaitabel op basis van een specifieke celwaarde met VBA-code

De volgende VBA-code kan u helpen bij het filteren van een draaitabel op basis van een specifieke celwaarde in Excel. Ga als volgt te werk.

1. Voer een waarde in waarop u de draaitabel wilt filteren op basis van een cel van tevoren (hier selecteer ik cel H6).

2. Open het werkblad met de draaitabel die u op celwaarde filtert. Klik vervolgens met de rechtermuisknop op de bladtab en selecteer Bekijk code in het contextmenu. Zie screenshot:

3. In de opening Microsoft Visual Basic voor toepassingen -venster, kopieer onderstaande VBA-code naar het codevenster.

VBA-code: filter draaitabel op basis van celwaarde

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

Opmerkingen: In de code,

1) "Sheet1”Is de naam van het werkblad.

2) "Draaitabel2”Is de naam van de draaitabel.

3) Het filterveld in de draaitabel wordt 'Categorie".

4) De waarde waarop u de draaitabel wilt filteren, wordt in de cel geplaatst H6.

U kunt de bovenstaande variabelewaarden naar behoefte wijzigen.

4. druk de anders + Q toetsen om de Microsoft Visual Basic voor toepassingen venster.

Vervolgens filtert de draaitabel op basis van de waarde in cel H6, zoals onderstaand screenshot:

U kunt de celwaarde naar behoefte wijzigen in andere.

Opmerking:: Waarden die u in cel H6 typt, moeten exact overeenkomen met de waarden in de vervolgkeuzelijst Categorie van de draaitabel.

De beste tools voor kantoorproductiviteit

Kutools voor Excel lost de meeste van uw problemen op en verhoogt uw productiviteit met 80%

visfuik: Snel invoegen complexe formules, grafieken en alles wat je eerder hebt gebruikt; Versleutel cellen met wachtwoord; Maak een mailinglijst en stuur e-mails ...
Super Formula-balk (bewerk eenvoudig meerdere regels tekst en formule); Lay-out lezen (gemakkelijk grote aantallen cellen lezen en bewerken); Plakken in gefilterd bereik...
Voeg cellen / rijen / kolommen samen zonder gegevens te verliezen; Gespleten cellen inhoud; Combineer dubbele rijen / kolommen... Voorkom dubbele cellen; Vergelijk Ranges...
Selecteer Dupliceren of Uniek Rijen; Selecteer lege rijen (alle cellen zijn leeg); Super zoeken en fuzzy zoeken in veel werkboeken; Willekeurige selectie ...
Exacte kopie Meerdere cellen zonder de formuleverwijzing te wijzigen; Maak automatisch verwijzingen naar meerdere bladen; Plaats kogels, Selectievakjes en meer ...
Extraheer tekst, Tekst toevoegen, Verwijderen op positie, Ruimte verwijderen; Paging-subtotalen maken en afdrukken; Converteren tussen celinhoud en opmerkingen...
Super filter (bewaar en pas filterschema's toe op andere bladen); Geavanceerd sorteren per maand / week / dag, frequentie en meer; Speciaal filter door vet, cursief ...
Combineer werkmappen en werkbladen; Tabellen samenvoegen op basis van sleutelkolommen; Gegevens splitsen in meerdere bladen; Batch Converteer xls, xlsx en PDF...
Meer dan 300 krachtige functies. Ondersteunt Office / Excel 2007-2021 en 365. Ondersteunt alle talen. Eenvoudig te implementeren in uw onderneming of organisatie. Volledige functies Gratis proefperiode van 30 dagen. 60 dagen geld-terug-garantie.

Lees verder... Gratis download... Aankoop...

Office-tabblad Brengt een interface met tabbladen naar Office en maakt uw werk veel gemakkelijker

Schakel bewerken en lezen met tabbladen in Word, Excel, PowerPoint in, Publisher, Access, Visio en Project.
Open en maak meerdere documenten in nieuwe tabbladen van hetzelfde venster in plaats van in nieuwe vensters.
Verhoogt uw productiviteit met 50% en vermindert honderden muisklikken voor u elke dag!

Lees verder... Gratis download... Aankoop...

Heb je vragen? Stel ze hier. (23)

Nog geen beoordelingen. Beoordeel als eerste!

Daniel

ongeveer 4 jaar geleden

#25756

Deze opmerking is gemaakt door de moderator op de site

Met behulp van deze code (uiteraard geüpdatet voor mijn variabelen), verandert het filter bij het wijzigen van het veld even in de juiste en wordt vervolgens vrijwel onmiddellijk gewist. Ik probeer erachter te komen waarom het dit doet (vraag ik me af of het iets te maken heeft met de ClearAllFilters aan het einde van de sub?)

Antwoorden

Justin

ongeveer 4 jaar geleden

#26177

Deze opmerking is gemaakt door de moderator op de site

Hoe zou u dit doen met een rapportfilter met een hiërarchie?

Antwoorden

Ignacia

ongeveer 3 jaar geleden

#30976

Deze opmerking is gemaakt door de moderator op de site

Hoi! Bedankt voor je macro.

Ik probeerde het voor meer dan één draaitabel op dezelfde pagina te gebruiken, maar het werkt niet. Ik schreef het als volgt:

Particulier subwerkblad_Wijziging (ByVal-doel als bereik)
Dim xPTable1 als draaitabel
Dim xPFile1 als draaiveld
Dim xStr1 als string
On Error Resume Next
Als Intersect (Target, Range ("D7")) niets is, sluit dan Sub af
Application.ScreenUpdating = False
Stel xPTable1 = Werkbladen ("BUSCADOR") in. Draaitabellen ("PV_ETAPA1")
Stel xPFile1 = xPTable1.PivotFields ("ETAPA1") in
xStr1 = Doel.Tekst
xPFile1.Alle filters wissen
xPFile1.CurrentPage = xStr1
Application.ScreenUpdating = True

Dim xPTable2 als draaitabel
Dim xPFile2 als draaiveld
Dim xStr2 als string
On Error Resume Next
Als Intersect (Target, Range ("G7")) niets is, sluit dan Sub af
Application.ScreenUpdating = False
Stel xPTable2 = Werkbladen ("BUSCADOR") in. Draaitabellen ("PV_ETAPA2")
Stel xPFile2 = xPTable2.PivotFields ("ETAPA2") in
xStr2 = Doel.Tekst
xPFile2.Alle filters wissen
xPFile2.CurrentPage = xStr2
Application.ScreenUpdating = True

End Sub

Misschien kunnen jullie me helpen!

Dank bij voorbaat!

Antwoorden

michael Ignacia

ongeveer 3 jaar geleden

#30977

Deze opmerking is gemaakt door de moderator op de site

Hi

bedankt voor de macro

Ik probeer hetzelfde, maar krijg het niet werkend op 2 tabellen. ze kijken allebei naar dezelfde cel, alleen 2 verschillende draaitabellen

bedankt

Antwoorden

Oksana michael

ongeveer 1 jaar geleden

#30978

Deze opmerking is gemaakt door de moderator op de site

U moet de naam van de draaitabel wijzigen. Elke draaitabel heeft een andere naam. om dat te krijgen, klik met de rechtermuisknop op het draaipunt en selecteer de draaitabelinstellingen, de naam staat bovenaan

Antwoorden

Ambrose Oksana

ongeveer 2 maanden geleden

#42326

Deze opmerking is gemaakt door de moderator op de site

Hallo,

Je kunt geen commentaar toevoegen aan de naam van de tweede TCD in de macro voor de functie van twee personen.
Pourriez-vous m'aider?

dank u

Antwoorden

Aravind

ongeveer 2 jaar geleden

#32775

Deze opmerking is gemaakt door de moderator op de site

Hallo, om de een of andere reden verschijnt deze macro na het openen van de visuele basispagina helemaal niet. Ik kan deze macro niet inschakelen/uitvoeren, ik heb alle instellingen van het vertrouwenscentrum gecontroleerd, maar er gebeurt niets, help me alstublieft

Antwoorden

Heather

ongeveer 2 jaar geleden

#33165

Deze opmerking is gemaakt door de moderator op de site

Hallo, ik krijg dit niet voor elkaar. De cel waarnaar ik wil verwijzen, is doorgetrokken uit een formule - zou dit de reden zijn waarom het filter het niet kan vinden omdat het naar de formule kijkt in plaats van naar de waarde die de formule retourneert? Bij voorbaat dank Heather McDonagh

Antwoorden

Sabrina Heather

ongeveer 1 jaar geleden

#33166

Deze opmerking is gemaakt door de moderator op de site

Hallo Heather, heb je een oplossing gevonden. Ik heb net hetzelfde probleem.

Antwoorden

AKTaylor

ongeveer 2 jaar geleden

#33770

Deze opmerking is gemaakt door de moderator op de site

Ik kon 3 verschillende pivots die op hetzelfde tabblad staan, wijzigen/filteren. Ik heb ook een rij toegevoegd aan mijn dataset "Geen gegevens gevonden", anders liet het het filter op "ALL" staan, wat ik niet wilde. Het bovenstaande was een grote hulp om me een pluim te geven met het management, dus ik wilde het delen. Merk op dat de (Alle) hoofdlettergevoelig is, het kostte me wat tijd om dat uit te zoeken.
Particulier subwerkblad_Wijziging (ByVal-doel als bereik)
'test
Dim xPTable als draaitabel
Dim xPFile als draaiveld
Dim xStr als tekenreeks

Dim x2PTable als draaitabel
Dim x2PFile als draaiveld
Dim x2Str als string

Dim x3PTable als draaitabel
Dim x3PFile als draaiveld
Dim x3Str als string

On Error Resume Next
Als Intersect (Target, Range ("a2:e2")) niets is, sluit dan Sub af

Application.ScreenUpdating = False

'tbl-1'
Stel xPTable = Worksheets ("Graphical") in. Draaitabellen ("PivotTable1")
Stel xPFile = xPTable.PivotFields("MR Afdeling - Afdeling")
xStr = Doel.Tekst
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr
Als xPFile.CurrentPage = "(Alle)" Dan xPFile.CurrentPage = "Geen gegevens gevonden"

'tbl-2'
Stel x2PTable = Worksheets("Graphical").PivotTables("PivotTable2") in
Stel x2PFile = x2PTable.PivotFields("MR Afdeling - Afdeling")
x2Str = Doel.Tekst
x2PFile.ClearAllFilters
x2PFfile.CurrentPage = x2Str
Als x2PFile.CurrentPage = "(Alle)" Dan x2PFile.CurrentPage = "Geen gegevens gevonden"

'tbl-3'
Stel x3PTable = Worksheets("Graphical").PivotTables("PivotTable3") in
Stel x3PFile = x3PTable.PivotFields("MR Afdeling - Afdeling")
x3Str = Doel.Tekst
x3PFile.ClearAllFilters
x3PFfile.CurrentPage = x3Str
Als x3PFile.CurrentPage = "(Alle)" Dan x3PFile.CurrentPage = "Geen gegevens gevonden"

Application.ScreenUpdating = True

End Sub

Antwoorden

Drew

ongeveer 2 jaar geleden

#34435

Deze opmerking is gemaakt door de moderator op de site

Is dit mogelijk met google sheets? Zo ja, hoe?

Antwoorden

Vibrator Drew

ongeveer 1 jaar geleden

#34436

Deze opmerking is gemaakt door de moderator op de site

Google Spreadsheets vereist geen draaitabel. u kunt direct uitvoeren via de filterfunctie

Antwoorden

sdas34

ongeveer 2 jaar geleden

#34609

Deze opmerking is gemaakt door de moderator op de site

Ik wil graag meerdere Worksheet Change-code in hetzelfde werkblad gebruiken. Hoe doe je dat? Mijn code is als volgt:
Particulier subwerkblad_Wijziging (ByVal-doel als bereik)
'Pivottabelfilter op basis van celwaarde'
Dim xPTable als draaitabel
Dim xPFile als draaiveld
Dim xStr als tekenreeks
On Error Resume Next
Als Intersect (Target, Range ("D20:D21")) niets is, sluit dan Sub af
Application.ScreenUpdating = False
Stel xPTable = Worksheets ("Blad1") in. Draaitabellen ("PivotTable2")
Stel xPFile = xPTable.PivotFields ("Designation") in
xStr = Doel.Tekst
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr
Application.ScreenUpdating = True
End Sub

Privé subwerkblad_Change2 (ByVal-doel als bereik)
'Pivot tabel filter gebaseerd op celwaarde 2'
Dim xPTable als draaitabel
Dim xPFile als draaiveld
Dim xStr als tekenreeks
On Error Resume Next
Als Intersect (Target, Range ("H20:H21")) niets is, sluit dan Sub af
Application.ScreenUpdating = False
Stel xPTable = Worksheets ("Blad1") in. Draaitabellen ("PivotTable2")
Stel xPFile = xPTable.PivotFields ("Offering") in
xStr = Doel.Tekst
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr
Application.ScreenUpdating = True
End Sub

Antwoorden

Rapport

Fernando

ongeveer 2 jaar geleden

#35024

Deze opmerking is gemaakt door de moderator op de site

Olá, zoek de saber-zoekmachine om meer te filteren in een van de categorieën van poderia ser?

Antwoorden

Oksana

ongeveer 1 jaar geleden

#35785

Deze opmerking is gemaakt door de moderator op de site

Wat als ik de selectiecel wil koppelen aan een ander tabblad? Dit is mijn code tot nu toe
Particulier subwerkblad_Wijziging (ByVal-doel als bereik)
Dim xPTable1 als draaitabel
Dim xPFile1 als draaiveld
Dim xStr1 als string
On Error Resume Next
Als Intersect (Target, Range ("B1")) niets is, sluit dan Sub af
Application.ScreenUpdating = False
Stel xPTable1 = Worksheets ("SM_SKU PIVOTS") in. Draaitabellen ("PivotTable1")
Stel xPFile1 = xPTable1.PivotFields ("Geografie") in
xStr1 = Doel.Tekst
xPFile1.Alle filters wissen
xPFile1.CurrentPage = xStr1
Application.ScreenUpdating = True

Dim xPTable2 als draaitabel
Dim xPFile2 als draaiveld
Dim xStr2 als string
On Error Resume Next
Als Intersect (Target, Range ("B1")) niets is, sluit dan Sub af
Application.ScreenUpdating = False
Stel xPTable2 = Worksheets ("SM_SKU PIVOTS") in. Draaitabellen ("PivotTable4")
Stel xPFile2 = xPTable2.PivotFields ("Geografie") in
xStr2 = Doel.Tekst
xPFile2.Alle filters wissen
xPFile2.CurrentPage = xStr2
Application.ScreenUpdating = True

Dim xPTable3 als draaitabel
Dim xPFile3 als draaiveld
Dim xStr3 als string
On Error Resume Next
Als Intersect (Target, Range ("B1")) niets is, sluit dan Sub af
Application.ScreenUpdating = False
Stel xPTable3 = Worksheets ("SM_SKU PIVOTS") in. Draaitabellen ("PivotTable8")
Stel xPFile3 = xPTable3.PivotFields ("Geografie") in
xStr3 = Doel.Tekst
xPFile3.Alle filters wissen
xPFile3.CurrentPage = xStr3
Application.ScreenUpdating = True

End Sub

Antwoorden

Alex

ongeveer 9 maanden geleden

#38505

Deze opmerking is gemaakt door de moderator op de site

Hallo!

Ik ben nieuw met VBA en ik zou graag een code willen hebben om een spilfilter te selecteren op basis van een celbereik.
Hoe kan ik "CurrentPage" veranderen in een bereikwaarde?
Dank je!!
-------------------------------------------------- -----------------------------------------
Sub PrintTour()

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

Antwoorden

Lans

ongeveer 8 maanden geleden

#38840

Deze opmerking is gemaakt door de moderator op de site

Heel erg bedankt voor deze code! Ik kreeg het werkend nadat ik het had aangepast om aan mijn velden te voldoen, maar na het opmaken van enkele wijzigingen in mijn blad werkt het nu niet! Ik heb het van A1 naar B1 verplaatst, wat celopmaak gewijzigd om het te laten opvallen, enz. Niets is te gek, maar nu wordt het niet bijgewerkt wanneer ik tekst in B1 verander. Heeft iemand ideeën?

Particulier subwerkblad_Wijziging (ByVal-doel als bereik)
'test
Dim xPTable als draaitabel
Dim xPFile als draaiveld
Dim xStr als tekenreeks

Dim x2PTable als draaitabel
Dim x2PFile als draaiveld
Dim x2Str als string

Dim x3PTable als draaitabel
Dim x3PFile als draaiveld
Dim x3Str als string

On Error Resume Next
Als Intersect (Target, Range ("b1")) niets is, sluit dan Sub af

Application.ScreenUpdating = False

'tbl-1'
Stel xPTable = Worksheets ("Line Report") in. Draaitabellen ("PivotTable7")
Stel xPFile = xPTable.PivotFields ("Utopia Source") in
xStr = Doel.Tekst
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr

'tbl-2'
Stel x2PTable = Worksheets ("Line Report") in. Draaitabellen ("PivotTable2")
Stel x2PFile = x2PTable.PivotFields ("Utopia Source") in
x2Str = Doel.Tekst
x2PFile.ClearAllFilters
x2PFfile.CurrentPage = x2Str

'tbl-3'
Stel x3PTable = Worksheets ("Line Report") in. Draaitabellen ("PivotTable3")
Stel x3PFile = x3PTable.PivotFields ("Utopia Source") in
x3Str = Doel.Tekst
x3PFile.ClearAllFilters
x3PFfile.CurrentPage = x3Str

Application.ScreenUpdating = True

End Sub

Antwoorden

crystal Lans

ongeveer 8 maanden geleden

#38901

Deze opmerking is gemaakt door de moderator op de site

Hallo Lans,
Ik heb je code getest en in mijn geval werkt het prima. Het wijzigen van het celformaat heeft geen invloed op de werking van de code.

Antwoorden

Rapport

ongeveer 7 maanden geleden

#39652

Deze opmerking is gemaakt door de moderator op de site

Hoe werkt het met Power Pivot bij gebruik van meerdere tabellen? Ik nam macro op en veranderde de waarde in filter. Enkele wijzigingen aangebracht om de bovenstaande code te laten werken. Maar het gooit Type mismatch-fout. Wat ik ook doe.

Antwoorden

crystal DK

ongeveer 7 maanden geleden

#39718

Deze opmerking is gemaakt door de moderator op de site

Hallo DK,
De methode werkt niet voor Power Pivot. Excuses voor het ongemak.

Antwoorden

Rapport

Ambrose

ongeveer 2 maanden geleden

#42309

Deze opmerking is gemaakt door de moderator op de site

Hallo,
Heel erg bedankt voor deze uitleg.

Gebruik een filter (1 cellule) in F4 bijvoorbeeld om twee TCD-filters te filteren die over mijn feuille gaan.

Als je een TCD gebruikt, is het de bedoeling dat je de tweede keer een essay schrijft, maar er is geen mars.
Kun je me helpen?

Heel hartelijk bedankt
Ambrose

Antwoorden

Ambrose

ongeveer 2 maanden geleden

#42324

Deze opmerking is gemaakt door de moderator op de site

Hallo,

Merci beaucoup pour cette explication qui marche parfaitement.
In revanche, j'aimerais pouvoir utiliser ce code pour pouvoir filter deux tableaux croisés dynamiques en même temps qui sont sur la même feuille. Het kleine verschil tussen twee tweeën kan niet gebruikt worden door dezelfde bronnen. In revanche, het filter op het water is gebaseerd op TDC en het is de tijd.

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

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

Particulier subwerkblad_Wijziging (ByVal-doel als bereik)
'Bijwerken door' Extendoffice 20180702
Dim xPTable als draaitabel
Dim xPFile als draaiveld
Dim xStr als tekenreeks
On Error Resume Next
Als Intersect (Target, Range ("G4")) niets is, sluit dan Sub af
Application.ScreenUpdating = False
Set xPTable = Worksheets("Cadrage").PivotTables("Tableau croisé dynamique7")
Stel xPFile = xPTable.PivotFields("N°PROJET") in
xStr = Doel.Tekst
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr
Application.ScreenUpdating = True
End Sub

Heel hartelijk bedankt

Antwoorden

crystal Ambrose

ongeveer 2 maanden geleden

#42387

Deze opmerking is gemaakt door de moderator op de site

Hallo Ambroise,

Sorry dat het moeilijk is om deze code aan te passen aan uw behoeften. Als u meerdere draaitabellen met één filter wilt filteren, kunnen de methoden in dit artikel hieronder u een plezier doen:
Hoe een enkele slicer verbinden met meerdere draaitabellen in Excel?

Antwoorden

Rapport

Er zijn nog geen reacties geplaatst