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

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

Normaal gesproken filteren we gegevens in een draaitabel door waarden in de vervolgkeuzelijst te controleren, zoals het linker screenshot laat zien. Als u een draaitabel dynamischer wilt maken door te filteren, kunt u proberen deze te filteren op basis van de waarde in een specifieke cel. De VBA-methode in dit artikel helpt u bij het oplossen van het probleem.

Normaal gesproken filteren we gegevens in een draaitabel door waarden in de vervolgkeuzelijst te controleren, zoals het linker screenshot laat zien. Als u een draaitabel dynamischer wilt maken door te filteren, kunt u proberen deze te filteren op basis van de waarde in een specifieke cel. De VBA-methode in dit artikel helpt u bij het oplossen van het probleem.

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

Notes: 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.


Gerelateerde artikelen:


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-2019 en 365. Ondersteunt alle talen. Eenvoudig te implementeren in uw onderneming of organisatie. Gratis proefperiode van 30 dagen met volledige functies. 60 dagen geld-terug-garantie.
kte tabblad 201905

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 elke dag honderden muisklikken!
officetab onderkant
Comments (15)
Nog geen beoordelingen. Beoordeel als eerste!
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?)
Deze opmerking is gemaakt door de moderator op de site
Hoe zou u dit doen met een rapportfilter met een hiërarchie?
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!
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
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
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
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
Deze opmerking is gemaakt door de moderator op de site
Hallo Heather, heb je een oplossing gevonden. Ik heb net hetzelfde probleem.
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 As String

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
x2PFile.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
x3PFile.CurrentPage = x3Str
Als x3PFile.CurrentPage = "(Alle)" Dan x3PFile.CurrentPage = "Geen gegevens gevonden"

Application.ScreenUpdating = True

End Sub
Deze opmerking is gemaakt door de moderator op de site
Is dit mogelijk met google sheets? Zo ja, hoe?
Deze opmerking is gemaakt door de moderator op de site
Google Spreadsheets vereist geen draaitabel. u kunt direct uitvoeren via de filterfunctie
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 As String
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 As String
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
Deze opmerking is gemaakt door de moderator op de site
Olá, gostaria de saber se quisesse filtrar mais de uma categoria como poderia ser?
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
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
Er zijn nog geen reacties geplaatst
Laat uw commentaar
Posten als gast
×
Beoordeel dit bericht:
0  Personages
Voorgestelde locaties