Hvordan filtreres pivottabellen baseret på en bestemt celleværdi i Excel?

Normalt filtrerer vi data i en pivottabel ved at vælge elementer i rullelisten som vist på skærmbilledet nedenfor. Faktisk kan du filtrere en pivottabel baseret på værdien i en bestemt celle. VBA-metoden i denne artikel hjælper dig med at løse problemet.

Filtrer pivottabel baseret på en bestemt celleværdi med VBA-kode

Filtrer pivottabel baseret på en bestemt celleværdi med VBA-kode

Følgende VBA-kode kan hjælpe dig med at filtrere en pivottabel baseret på en bestemt celleværdi i Excel. Gør som følger.

1. Indtast venligst en værdi, som du vil filtrere pivottabellen baseret på i en celle på forhånd (her vælger jeg celle H6).

2. Åbn regnearket indeholder pivottabellen, som du vil filtrere efter celleværdi. Højreklik derefter på arkfanen, og vælg Vis kode i genvejsmenuen. Se skærmbillede:

3. I åbningen Microsoft Visual Basic til applikationer vindue, kopier under VBA-koden til kodevinduet.

VBA-kode: Filter-pivottabel baseret på celleværdi

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

Noter: I koden,

1) "Sheet1”Er navnet på regnearket.

2) "Pivottabel2”Er navnet på pivottabellen.

3) Filtreringsfeltet i drejetabellen kaldes "Boligtype".

4) Den værdi, du vil filtrere pivottabellen, placeres i cellen H6.

Du kan ændre ovenstående variabelværdier efter behov.

4. Tryk på andre + Q taster for at lukke Microsoft Visual Basic til applikationer vindue.

Derefter filtreres pivottabellen baseret på værdien i celle H6 som vist nedenstående skærmbillede:

Du kan ændre celleværdien til andre, som du har brug for.

Bemærk: Værdier, du skriver i celle H6, skal nøjagtigt matche værdierne i rullelisten Kategori i pivottabellen.

Relaterede artikler:

De bedste Office-produktivitetsværktøjer

Kutools til Excel løser de fleste af dine problemer og øger din produktivitet med 80%

Genbruge: Indsæt hurtigt komplekse formler, diagrammer og alt, hvad du har brugt før; Krypter celler med adgangskode Opret postliste og send e-mails ...
Super formel bar (let redigere flere linjer med tekst og formel); Læsning Layout (let at læse og redigere et stort antal celler); Indsæt til filtreret rækkevidde...
Flet celler / rækker / kolonner uden at miste data; Split celler indhold; Kombiner duplikerede rækker / kolonner... Forhindre duplikerede celler; Sammenlign områder...
Vælg Duplicate eller Unique Rækker; Vælg tomme rækker (alle celler er tomme); Super Find og Fuzzy Find i mange arbejdsbøger; Tilfældig valg ...
Præcis kopi Flere celler uden at ændre formelreference; Auto Opret referencer til flere ark; Indsæt kugler, Afkrydsningsfelter og mere ...
Uddrag tekst, Tilføj tekst, Fjern efter position, Fjern mellemrum; Opret og udskriv personsøgningssubtotaler; Konverter mellem celler indhold og kommentarer...
Superfilter (gem og anvend filterskemaer på andre ark); Avanceret sortering efter måned / uge / dag, hyppighed og mere; Specielt filter af fed, kursiv ...
Kombiner arbejdsbøger og arbejdsark; Fletabeller baseret på nøglekolonner; Opdel data i flere ark; Batch Konverter xls, xlsx og PDF...
Mere end 300 kraftfulde funktioner. Understøtter Office / Excel 2007-2021 og 365. Understøtter alle sprog. Nem implementering i din virksomhed eller organisation. Fuld funktioner 30-dages gratis prøveperiode. 60 dages pengene tilbage garanti.

Læs mere ... Gratis download... Køb...

Fanen Office bringer en grænseflade til et kontor med Office, og gør dit arbejde meget lettere

Aktiver redigering og læsning af faner i Word, Excel, PowerPoint, Publisher, Access, Visio og Project.
Åbn og opret flere dokumenter i nye faner i det samme vindue snarere end i nye vinduer.
Øger din produktivitet med 50 % og reducerer hundredvis af museklik for dig hver dag!

Læs mere ... Gratis download... Køb...

Kommentarer (23)

Ingen vurderinger endnu. Vær den første til at bedømme!

Daniel

omkring 4 år siden

#25756

Denne kommentar blev minimeret af moderatoren på webstedet

Ved at bruge denne kode (opdateret til mine variabler selvfølgelig), når du ændrer feltet, skifter filteret et øjeblik til det korrekte, og rydder sig selv næsten med det samme. Forsøger at finde ud af, hvorfor det gør dette (gad vide om det har noget at gøre med ClearAllFilters i slutningen af sub'en?)

Svar

Justin

omkring 4 år siden

#26177

Denne kommentar blev minimeret af moderatoren på webstedet

Hvordan ville du gøre dette med et rapportfilter, der har et hierarki?

Svar

Ignacia

omkring 3 år siden

#30976

Denne kommentar blev minimeret af moderatoren på webstedet

Hej! Tak for din makro.

Jeg prøvede at bruge det til mere end én pivottabel på samme side, men det virker ikke. Jeg skrev det sådan her:

Privat Sub Worksheet_Change (ByVal Target As Range)
Dim xPTable1 Som pivottabel
Dim xPFile1 Som PivotField
Dim xStr1 Som streng
On Error Resume Next
Hvis Intersect(Target, Range("D7")) er intet, så Afslut Sub
Application.ScreenUpdating = False
Indstil xPTable1 = Arbejdsark("BUSCADOR"). Pivottabeller("PV_ETAPA1")
Indstil xPFile1 = xPTable1.PivotFields("ETAPA1")
xStr1 = Target.Text
xPFile1.ClearAllFilters
xPFile1.CurrentPage = xStr1
Application.ScreenUpdating = True

Dim xPTable2 Som pivottabel
Dim xPFile2 Som PivotField
Dim xStr2 Som streng
On Error Resume Next
Hvis Intersect(Target, Range("G7")) er intet, så Afslut Sub
Application.ScreenUpdating = False
Indstil xPTable2 = Arbejdsark("BUSCADOR"). Pivottabeller("PV_ETAPA2")
Indstil xPFile2 = xPTable2.PivotFields("ETAPA2")
xStr2 = Target.Text
xPFile2.ClearAllFilters
xPFile2.CurrentPage = xStr2
Application.ScreenUpdating = True

End Sub

Måske kan du hjælpe mig!

Tak på forhånd!

Svar

michael Ignacia

omkring 2 år siden

#30977

Denne kommentar blev minimeret af moderatoren på webstedet

Hi

tak for makroen

Jeg prøver det samme, men kan ikke få det til at virke på 2 borde. de ser begge på den samme celle kun 2 forskellige pivottabeller

tak

Svar

Oksana michael

cirka 1 år siden

#30978

Denne kommentar blev minimeret af moderatoren på webstedet

Du skal ændre pivottabellens navn. Hver pivottabel har et andet navn. for at få det, højreklik på pivoten og vælg pivottabelindstillinger, navnet vil være øverst

Svar

Ambrose Oksana

for ca. 3 uger siden

#42326

Denne kommentar blev minimeret af moderatoren på webstedet

Hej,

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?

Tak

Svar

Aravind

omkring 2 år siden

#32775

Denne kommentar blev minimeret af moderatoren på webstedet

Hej af en eller anden grund dukker denne makro slet ikke op efter at have gået ind på den visuelle grundside. Jeg er ikke i stand til at aktivere/køre denne makro, jeg har tjekket alle indstillinger for tillidscenter, men der sker ikke noget, venligst hjælp mig

Svar

Heather

omkring 2 år siden

#33165

Denne kommentar blev minimeret af moderatoren på webstedet

Hej, jeg kan ikke få det til at virke. Cellen, jeg vil henvise til, trækkes ind fra en formel - ville det være grunden til, at filteret ikke kan finde den, da det kigger på formlen i stedet for den værdi, som formlen returnerer? På forhånd tak Heather McDonagh

Svar

Sabrina Heather

cirka 1 år siden

#33166

Denne kommentar blev minimeret af moderatoren på webstedet

Hej Heather, fandt du en løsning. Jeg har bare det samme problem.

Svar

AKTaylor

omkring 2 år siden

#33770

Denne kommentar blev minimeret af moderatoren på webstedet

Jeg var i stand til at ændre/filtrere 3 forskellige pivoter, som er på samme fane. Jeg tilføjede også en række i mit datasæt "Ingen data fundet", ellers efterlod det filteret til "ALLE", hvilket jeg ikke ville have. Ovenstående var en stor hjælp til at give mig Kudos med ledelsen, så jeg ville gerne dele. Bemærk, at (Alle) skelner mellem store og små bogstaver, det tog mig lidt at finde ud af.
Privat Sub Worksheet_Change (ByVal Target As Range)
'prøve
Dim xPTable Som pivottabel
Dim xPFile Som PivotField
Dim xStr As String

Dim x2PTable Som pivottabel
Dim x2PFile Som PivotField
Dim x2Str As String

Dim x3PTable Som pivottabel
Dim x3PFile Som PivotField
Dim x3Str As String

On Error Resume Next
Hvis Intersect(Target, Range("a2:e2")) er intet, så Afslut Sub

Application.ScreenUpdating = False

'tbl-1
Indstil xPTable = Worksheets("Graphical").PivotTables("PivotTable1")
Indstil xPFile = xPTable.PivotFields("MR Department - Department")
xStr = Target.Text
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr
Hvis xPFile.CurrentPage = "(Alle)" Så xPFile.CurrentPage = "Ingen data fundet"

'tbl-2
Indstil x2PTable = Worksheets("Graphical").PivotTables("PivotTable2")
Indstil x2PFile = x2PTable.PivotFields("MR Department - Department")
x2Str = Target.Text
x2PFile.ClearAllFilters
x2PFile.CurrentPage = x2Str
Hvis x2PFile.CurrentPage = "(Alle)" Så er x2PFile.CurrentPage = "Ingen data fundet"

'tbl-3
Indstil x3PTable = Worksheets("Graphical").PivotTables("PivotTable3")
Indstil x3PFile = x3PTable.PivotFields("MR Department - Department")
x3Str = Target.Text
x3PFile.ClearAllFilters
x3PFile.CurrentPage = x3Str
Hvis x3PFile.CurrentPage = "(Alle)" Så er x3PFile.CurrentPage = "Ingen data fundet"

Application.ScreenUpdating = True

End Sub

Svar

Drew

omkring 2 år siden

#34435

Denne kommentar blev minimeret af moderatoren på webstedet

Er dette muligt med google sheets? Hvis ja, hvordan?

Svar

Vibhor Drew

cirka 1 år siden

#34436

Denne kommentar blev minimeret af moderatoren på webstedet

Google Sheets kræver ikke nogen pivottabel. du kan udføre direkte gennem filterfunktionen

Svar

sdas34

omkring 2 år siden

#34609

Denne kommentar blev minimeret af moderatoren på webstedet

Jeg vil gerne bruge flere regnearksændringskoder i samme regneark. Hvordan gør man det? Min kode er som nedenfor:
Privat Sub Worksheet_Change (ByVal Target As Range)
'Pivottabelfilter baseret på celleværdi
Dim xPTable Som pivottabel
Dim xPFile Som PivotField
Dim xStr As String
On Error Resume Next
Hvis Intersect(Target, Range("D20:D21")) er intet, så Afslut Sub
Application.ScreenUpdating = False
Indstil xPTable = Worksheets("Sheet1").PivotTables("PivotTable2")
Indstil 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)
'Pivottabelfilter baseret på celleværdi 2
Dim xPTable Som pivottabel
Dim xPFile Som PivotField
Dim xStr As String
On Error Resume Next
Hvis Intersect(Target, Range("H20:H21")) er intet, så Afslut Sub
Application.ScreenUpdating = False
Indstil xPTable = Worksheets("Sheet1").PivotTables("PivotTable2")
Indstil xPFile = xPTable.PivotFields("Offering")
xStr = Target.Text
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr
Application.ScreenUpdating = True
End Sub

Svar

Rapport

Fernando

cirka 1 år siden

#35024

Denne kommentar blev minimeret af moderatoren på webstedet

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

Svar

Oksana

cirka 1 år siden

#35785

Denne kommentar blev minimeret af moderatoren på webstedet

Hvad hvis jeg vil linke markeringscellen til en anden fane? Dette er min kode indtil videre
Privat Sub Worksheet_Change (ByVal Target As Range)
Dim xPTable1 Som pivottabel
Dim xPFile1 Som PivotField
Dim xStr1 Som streng
On Error Resume Next
Hvis Intersect(Target, Range("B1")) er intet, så Afslut Sub
Application.ScreenUpdating = False
Indstil xPTable1 = Worksheets("SM_SKU PIVOTS").PivotTables("PivotTable1")
Indstil xPFile1 = xPTable1.PivotFields("Geografi")
xStr1 = Target.Text
xPFile1.ClearAllFilters
xPFile1.CurrentPage = xStr1
Application.ScreenUpdating = True

Dim xPTable2 Som pivottabel
Dim xPFile2 Som PivotField
Dim xStr2 Som streng
On Error Resume Next
Hvis Intersect(Target, Range("B1")) er intet, så Afslut Sub
Application.ScreenUpdating = False
Indstil xPTable2 = Worksheets("SM_SKU PIVOTS").PivotTables("PivotTable4")
Indstil xPFile2 = xPTable2.PivotFields("Geografi")
xStr2 = Target.Text
xPFile2.ClearAllFilters
xPFile2.CurrentPage = xStr2
Application.ScreenUpdating = True

Dim xPTable3 Som pivottabel
Dim xPFile3 Som PivotField
Dim xStr3 Som streng
On Error Resume Next
Hvis Intersect(Target, Range("B1")) er intet, så Afslut Sub
Application.ScreenUpdating = False
Indstil xPTable3 = Worksheets("SM_SKU PIVOTS").PivotTables("PivotTable8")
Indstil xPFile3 = xPTable3.PivotFields("Geografi")
xStr3 = Target.Text
xPFile3.ClearAllFilters
xPFile3.CurrentPage = xStr3
Application.ScreenUpdating = True

End Sub

Svar

Alex

cirka 7 måneder siden

#38505

Denne kommentar blev minimeret af moderatoren på webstedet

Hello!

Jeg er ny med VBA, og jeg vil gerne have en kode til at vælge et pivotfilter baseret på et celleområde.
Hvordan kan jeg ændre "CurrentPage" til at være en intervalværdi?
Tak !!
-------------------------------------------------- -----------------------------------------
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

Svar

Lance

cirka 6 måneder siden

#38840

Denne kommentar blev minimeret af moderatoren på webstedet

Mange tak for denne kode! Jeg fik det til at virke efter at have justeret for at opfylde mine felter, men efter at have formateret nogle ændringer på mit ark nu virker det ikke! Jeg flyttede det fra A1 til B1, ændrede noget celleformatering for at få det til at skille sig ud osv. Ikke noget for vildt, men nu opdaterer det ikke, når jeg ændrer tekst i B1. Nogen der har nogle ideer?

Privat Sub Worksheet_Change (ByVal Target As Range)
'prøve
Dim xPTable Som pivottabel
Dim xPFile Som PivotField
Dim xStr As String

Dim x2PTable Som pivottabel
Dim x2PFile Som PivotField
Dim x2Str As String

Dim x3PTable Som pivottabel
Dim x3PFile Som PivotField
Dim x3Str As String

On Error Resume Next
Hvis Intersect(Target, Range("b1")) er intet, så Afslut Sub

Application.ScreenUpdating = False

'tbl-1
Indstil xPTable = Arbejdsark("Linjerapport"). Pivottabeller("Pivottabel7")
Indstil xPFile = xPTable.PivotFields("Utopia Source")
xStr = Target.Text
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr

'tbl-2
Indstil x2PTable = Arbejdsark("Linjerapport"). Pivottabeller("Pivottabel2")
Indstil x2PFile = x2PTable.PivotFields("Utopia Source")
x2Str = Target.Text
x2PFile.ClearAllFilters
x2PFile.CurrentPage = x2Str

'tbl-3
Indstil x3PTable = Arbejdsark("Linjerapport"). Pivottabeller("Pivottabel3")
Indstil x3PFile = x3PTable.PivotFields("Utopia Source")
x3Str = Target.Text
x3PFile.ClearAllFilters
x3PFile.CurrentPage = x3Str

Application.ScreenUpdating = True

End Sub

Svar

krystal Lance

cirka 6 måneder siden

#38901

Denne kommentar blev minimeret af moderatoren på webstedet

Hej Lance,
Jeg testede din kode, og den fungerer fint i mit tilfælde. Ændring af celleformatet påvirker ikke kodens funktion.

Svar

Rapport

cirka 5 måneder siden

#39652

Denne kommentar blev minimeret af moderatoren på webstedet

Hvordan fungerer det med Power Pivot, når du bruger flere tabeller? Jeg optog makro, der ændrede værdien i filteret. Foretog få ændringer for at få ovenstående kode til at fungere. Men det kaster Type mismatch fejl. Lige meget hvad jeg gør.

Svar

krystal DK

cirka 5 måneder siden

#39718

Denne kommentar blev minimeret af moderatoren på webstedet

Hej DK,
Metoden virker ikke for Power Pivot. Beklager ulejligheden.

Svar

Rapport

Ambrose

for ca. 3 uger siden

#42309

Denne kommentar blev minimeret af moderatoren på webstedet

Hej,
Mange tak for disse forklaringer.

J'aimerai utiliser un filtre (1 cellule) en F4 par exemple qui filterait 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.
Kan du hjælpe mig ?

Mange tak
Ambrose

Svar

Ambrose

for ca. 3 uger siden

#42324

Denne kommentar blev minimeret af moderatoren på webstedet

Hej,

Merci beaucoup pour cette forklaring qui marche parfaitement.
En revanche, j'aimerais pouvoir utiliser ce code pour pouvoir filtrerer 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 kilder. 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 :

Privat Sub Worksheet_Change (ByVal Target As Range)
'Opdater af Extendoffice 20180702
Dim xPTable Som pivottabel
Dim xPFile Som PivotField
Dim xStr As String
On Error Resume Next
Hvis Intersect(Target, Range("G4")) er intet, så Afslut Sub
Application.ScreenUpdating = False
Indstil xPTable = Worksheets("Cadrage").PivotTables("Tableau croisé dynamique7")
Indstil xPFile = xPTable.PivotFields("N°PROJET")
xStr = Target.Text
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr
Application.ScreenUpdating = True
End Sub

Mange tak

Svar

krystal Ambrose

for ca. 3 uger siden

#42387

Denne kommentar blev minimeret af moderatoren på webstedet

Hej Ambroise,

Beklager, det er svært at ændre denne kode, så den opfylder dine behov. Hvis du vil filtrere flere pivottabeller med et enkelt filter, kan metoderne i denne artikel nedenfor måske gøre dig en tjeneste:
Hvordan forbinder man en enkelt slicer til flere pivottabeller i Excel?

Svar

Rapport

Der er endnu ingen kommentarer her

Efterlad dine kommentarer

Sender som gæst

Navn (Påkrævet)

E-mail (Påkrævet)

Bedøm dette indlæg:

Nulstil

0 Tegn

Jeg accepterer vilkår og betingelser