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

Hvordan linkes Pivot Table-filter til en bestemt celle i Excel?

Hvis du vil linke et pivottabelfilter til en bestemt celle og gøre pivottabellen filtreret baseret på celleværdien, kan metoden i denne artikel hjælpe dig.

Link pivottabelfilter til en bestemt celle med VBA-kode


Link pivottabelfilter til en bestemt celle med VBA-kode

Pivottabellen, som du vil linke dens filterfunktion til en celleværdi, skal indeholde et filterfelt (navnet på filterfeltet spiller en vigtig rolle i den følgende VBA-kode).

Tag nedenstående pivottabel som et eksempel. Filterfeltet i pivottabellen kaldes Boligtype, og det inkluderer to værdier “faktor er repræsentativt for hele flåden imidlertid detaljerede dispersionssystemer modelstudier vil blive forbedret ved hjælp af road-by-road primær NO"Og"Salg”. Efter at have knyttet Pivot Table-filteret til en celle, skal de celleværdier, du vil anvende på filter Pivot Table, være "Expenses" og "Sales".

1. Vælg den celle (her vælger jeg celle H6), du vil linke til Pivot Table's filterfunktion, og indtast en af ​​filterværdierne i cellen på forhånd.

2. Åbn regnearket indeholder den pivottabel, du vil linke til cellen. Højreklik på arkfanen og vælg Vis kode fra genvejsmenuen. Se skærmbillede:

3. i Microsoft Visual Basic til applikationer vindue, kopier under VBA-koden til kodevinduet.

VBA-kode: Link pivottabelfilter til en bestemt celle

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")) 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:

1) "Sheet1”Er navnet på det åbnede regneark.
2) "Pivottabel2”Er navnet på pivottabellen, du vil linke dens filterfunktion til en celle.
3) Filtreringsfeltet i drejetabellen kaldes "Boligtype".
4) Den refererede celle er H6. Du kan ændre disse variable værdier baseret på dine behov.

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

Nu er filterfunktionen i pivottabellen knyttet til celle H6.

Opdater cellen H6, hvorefter tilsvarende data i pivottabellen filtreres ud baseret på den eksisterende værdi. Se skærmbillede:

Når du ændrer celleværdien, ændres de filtrerede data i pivottabellen automatisk. Se skærmbillede:


Vælg nemt hele rækker baseret på celleværdi i en certian-kolonne:

Vælg specifikke celler nytte af Kutools til Excel kan hjælpe dig med hurtigt at vælge hele rækker baseret på celleværdi i en certian-kolonne i Excel som vist nedenstående skærmbillede. Når du har valgt alle rækker baseret på celleværdi, kan du manuelt flytte eller kopiere dem til en ny placering, som du har brug for i Excel.
Download og prøv det nu! (30 dages gratis sti)


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-2019 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.
kte-fane 201905

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!
officetab bund
Sorter kommentarer efter
Kommentarer (32)
Ingen vurderinger endnu. Vær den første til at bedømme!
Denne kommentar blev minimeret af moderatoren på webstedet
hvordan man gør det på flere felter, da der i kode kun er ét mål
Denne kommentar blev minimeret af moderatoren på webstedet
Hej Frank
Det kan Sory ikke hjælpe dig med.
Denne kommentar blev minimeret af moderatoren på webstedet
Hvad hvis cellen, der er knyttet til pivottabellen, i dette tilfælde H6, er på et andet regneark? Hvordan ændrer det koden?
Denne kommentar blev minimeret af moderatoren på webstedet
hvad hvis jeg har mere end 1 pivottabel og at linke til 1 celle. Hvordan skal jeg ændre koden?
Denne kommentar blev minimeret af moderatoren på webstedet
Hej Jeri,
Jeg kan desværre ikke hjælpe dig med det. Velkommen til at stille ethvert spørgsmål i vores forum: https://www.extendoffice.com/forum.html for at få mere Excel-support fra Excel-professionelle eller andre Excel-fans.
Denne kommentar blev minimeret af moderatoren på webstedet
find disse og skift dem i Array(),Intersect(), Worksheets(), PivotFields()

Pivottabel1
Pivottabel2
Pivottabel3
Pivottabel4
H1
Arknavn
Feltnavn




Private Sub Worksheet_Change(ByVal Target As Range)
'Update by Extendoffice 20180702
    Dim xPTable As PivotTable
    Dim xPFile As PivotField
    Dim xPTabled As PivotTable
    Dim xPFiled As PivotField
    Dim xStr As String
    On Error Resume Next
    '리스트 만들기
    Dim listArray() As Variant
    listArray = Array("PivotTable1", "PivotTable2", "PivotTable3", "PivotTable4")
    If Intersect(Target, Range("H1")) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    For i = 0 To UBound(listArray)
        Set xPTable = Worksheets("SheetName").PivotTables(listArray(i))
        Set xPFile = xPTable.PivotFields("FieldName")
        'MsgBox (listArray(i))
        xStr = Target.Text
        xPFile.ClearAllFilters
        xPFile.CurrentPage = xStr
    Next
        Application.ScreenUpdating = True
End Sub
Denne kommentar blev minimeret af moderatoren på webstedet
Boa tarde...! Ótima publicação, como faço para utilizar o filtro em duas ou mais tabelas dinâmicas...? Agradeço desde já.

God eftermiddag...! Fantastisk udgivelse, hvordan bruger jeg filteret i to eller flere pivottabeller ...? Tak på forhånd.
Denne kommentar blev minimeret af moderatoren på webstedet
Hej Gilmar Alves,
Jeg kan desværre ikke hjælpe dig med det. Velkommen til at stille ethvert spørgsmål i vores forum: https://www.extendoffice.com/forum.html for at få mere Excel-support fra Excel-professionelle eller andre Excel-fans.
Denne kommentar blev minimeret af moderatoren på webstedet
Er der nogen, der har fundet ud af koblingsspørgsmålet med flere pivottabeller?
Denne kommentar blev minimeret af moderatoren på webstedet
Skift værdier i Array(), Worksheets() og Intersect()



**Find disse og skift dem**
Arknavn
E1
Pivottabel1
Pivottabel2
Pivottabel3




Privat Sub Worksheet_Change (ByVal Target As Range)
'Opdater af Extendoffice 20180702
Dim xPTable Som pivottabel
Dim xPFile Som PivotField

Dim xPTabled som pivottabel
Dim xPFiled Som PivotField

Dim xStr As String



On Error Resume Next

'리스트 만들기
Dim listArray() Som variant
listArray = Array("Pivottabel1", "Pivottabel2", "Pivottabel3")



Hvis Intersect(Target, Range("E1")) er intet, så Afslut Sub
Application.ScreenUpdating = False

For i = 0 til UBound(listArray)

Indstil xPTable = Worksheets("SheetName").PivotTables(listArray(i))
Indstil xPFile = xPTable.PivotFields("Company_ID")

xStr = Target.Text
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr



Næste

Application.ScreenUpdating = True



End Sub
Denne kommentar blev minimeret af moderatoren på webstedet
Ciao, sto provando a fare lo stesso esempio per far in modo che il filtro della pivot si setti sul valore della cella,
non riesco a farla funzionare.

Hvilken passaggio manca nella beskrivelse sopra?
Denne kommentar blev minimeret af moderatoren på webstedet
Hej,
Fik du en fejlmeddelelse? Jeg har brug for at vide mere specifikt om dit problem, såsom din Excel-version. Og hvis du ikke har noget imod det, så prøv at oprette dine data i en ny projektmappe og prøv igen, eller tag et skærmbillede af dine data og upload dem her.
Denne kommentar blev minimeret af moderatoren på webstedet
Hej,

Forsøgte at få dette til at virke for kolonnefilteret, men det ser ikke ud til at virke. Skal jeg bruge en anden kode til det?

Tak
Denne kommentar blev minimeret af moderatoren på webstedet
Hej Justin,
Fik du en fejlmeddelelse? Jeg har brug for at vide mere specifikt om dit problem.
Inden du anvender koden, glem ikke at ændre "arkets navn""navnet på pivottabellen""navnet på filteret i pivottabellen" og celle du vil filtrere pivottabellen baseret på (se skærmbillede).
https://www.extendoffice.com/images/stories/comments/comment-picture-zxm/4.png
Denne kommentar blev minimeret af moderatoren på webstedet
Hej Crystal,

Tak for din hjælp. Problemet er, at funktionen ikke gør noget af en eller anden grund. Lidt afklaring:

Pivotnavn: Order_Comp_B2C
Arknavn: Regneark
Filternavn: Ugenummer (jeg ændrede dette navn fra det, der var "Afsendelsesugenummer" i datafilen)
Celle, der skal ændres: O26 og O27 (dette bør gå inden for rækkevidde)

I denne pivot forsøger jeg at få filteret ændret for kolonnerne, jeg har intet i filterområdet i menuen Pivottabelfelter.

min kode er:

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("O26")) er intet, så Afslut Sub
Application.ScreenUpdating = False
Indstil xPTable = Arbejdsark("Beregningsark"). Pivottabeller("Order_Comp_B2C")
Indstil xPFile = xPTable.PivotFields("Ugenummer")
xStr = Target.Text
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr
Application.ScreenUpdating = True
End Sub

Tak,

Justin
Denne kommentar blev minimeret af moderatoren på webstedet
Hej Justin Teeuw,
Jeg har ændret Pivotnavn, arknavn, filternavn og celle for at ændre til de betingelser, du nævnte ovenfor, og prøvede den VBA-kode, du angav, fungerer det godt i mit tilfælde. Se følgende GIF eller den vedhæftede projektmappe.
Har du noget imod at oprette en ny projektmappe og prøve koden igen?
https://www.extendoffice.com/images/stories/comments/comment-picture-zxm/6.gif
Denne kommentar blev minimeret af moderatoren på webstedet
Hej Crystal,

Vedhæftet et skærmbillede af pivoten, den røde boks er det filter, jeg gerne vil ændre baseret på celleværdien.

Jeg vil helst bruge en række celler, der angiver flere ugenumre.

Tak,

Justin
Denne kommentar blev minimeret af moderatoren på webstedet
Hej Justin,
Beklager, at jeg ikke så det skærmbillede, du vedhæftede på siden. Måske er der en fejl på siden.
Hvis du stadig har brug for at løse problemet, e-mail mig via zxm@addin99.com. Beklager ulejligheden.
Denne kommentar blev minimeret af moderatoren på webstedet
Hej Justin Teeuw,
Prøv venligst følgende VBA-kode. Håber jeg kan hjælpe.

Private Sub Worksheet_Change(ByVal Target As Range)
    'Update by Extendoffice 20220706
    Dim I As Integer
    Dim xFilterStr1, xFilterStr2 As String
    On Error Resume Next
    If Intersect(Target, Range("O26:O27")) Is Nothing Then Exit Sub
    'Application.ScreenUpdating = False
    
    xFilterStr1 = Range("O26").Value
    xFilterStr2 = Range("O27").Value
    ActiveSheet.PivotTables("Order_Comp_B2C").PivotFields("Week Number"). _
        ClearAllFilters
    If xFilterStr1 = "" And xFilterStr2 = "" Then Exit Sub
    ActiveSheet.PivotTables("Order_Comp_B2C").PivotFields("Week Number"). _
        EnableMultiplePageItems = True
    xCount = ActiveSheet.PivotTables("Order_Comp_B2C").PivotFields("Week Number").PivotItems.Count

    For I = 1 To xCount
        If I <> xFilterStr1 And I <> xFilterStr2 Then
            ActiveSheet.PivotTables("Order_Comp_B2C").PivotFields("Week Number").PivotItems(I).Visible = False
        Else
            ActiveSheet.PivotTables("Order_Comp_B2C").PivotFields("Week Number").PivotItems(I).Visible = True
        End If
    Next

    'Application.ScreenUpdating = True
End Sub
Denne kommentar blev minimeret af moderatoren på webstedet
Jeg brugte det til en normal excell, og det fungerede. Men jeg kunne ikke bruge det til et lap regneark. måske skal jeg ændre det lidt?
Denne kommentar blev minimeret af moderatoren på webstedet
Hej maziaritib4 TIB,
Metoden er kun tilgængelig for Microsoft Excel. Beklager ulejligheden.
Denne kommentar blev minimeret af moderatoren på webstedet
Hej Justin,

Dette har fungeret perfekt, men jeg spekulerer på, om denne regel kan anvendes på flere pivottabeller inden for samme ark?

Tak,
James
Denne kommentar blev minimeret af moderatoren på webstedet
Hej James,

Ja, det er muligt, kode jeg brugte til dette er (4 pivoter og 2 cellereferencer):

Privat Sub Worksheet_Change (ByVal Target As Range)
Dim I som heltal
Dim xFilterStr1, xFilterStr2, yFilterstr1, yfilterstr2 Som streng
On Error Resume Next
Hvis Intersect(Target, Range("O26:P27")) er intet, så Afslut Sub

xFilterStr1 = Range("O26").Værdi
xFilterStr2 = Range("O27").Værdi
yFilterstr1 = Range("p26").Værdi
yfilterstr2 = Range("p27").Værdi
ActiveSheet.PivotTables("Order_Comp_B2C_Crea").PivotFields("Ugenummer"). _
ActiveSheet.PivotTables("Order_Comp_B2B_Crea").PivotFields("Ugenummer"). _
ActiveSheet.PivotTables("Order_Comp_B2C_Disp").PivotFields("Ugenummer"). _
ActiveSheet.PivotTables("Order_Comp_B2B_Disp").PivotFields("Ugenummer"). _
ClearAllFilters

Hvis xFilterStr1 = "" Og xFilterStr2 = "" Og yFilterstr1 = "" Og yfilterstr2 = "" Afslut Sub
ActiveSheet.PivotTables("Order_Comp_B2C_Crea").PivotFields("Ugenummer"). _
ActiveSheet.PivotTables("Order_Comp_B2B_Crea").PivotFields("Ugenummer"). _
ActiveSheet.PivotTables("Order_Comp_B2C_Disp").PivotFields("Ugenummer"). _
ActiveSheet.PivotTables("Order_Comp_B2B_Disp").PivotFields("Ugenummer"). _
EnableMultiplePageItems = Sand

xCount = ActiveSheet.PivotTables("Order_Comp_B2C_Crea").PivotFields("Ugenummer").PivotItems.Count
xCount = ActiveSheet.PivotTables("Order_Comp_B2B_Crea").PivotFields("Ugenummer").PivotItems.Count
yCount = ActiveSheet.PivotTables("Order_Comp_B2C_Disp").PivotFields("Ugenummer").PivotItems.Count
yCount = ActiveSheet.PivotTables("Order_Comp_B2B_Disp").PivotFields("Ugenummer").PivotItems.Count

For I = 1 Til xCount
Hvis jeg <> xFilterStr1 Og jeg <> xFilterStr2 Så
ActiveSheet.PivotTables("Order_Comp_B2C_Crea").PivotFields("Ugenummer").PivotItems(I).Visible = False
ActiveSheet.PivotTables("Order_Comp_B2B_Crea").PivotFields("Ugenummer").PivotItems(I).Visible = False
Else
ActiveSheet.PivotTables("Order_Comp_B2C_Crea").PivotFields("Ugenummer").PivotItems(I).Visible = True
ActiveSheet.PivotTables("Order_Comp_B2B_Crea").PivotFields("Ugenummer").PivotItems(I).Visible = True
End If
Næste

For I = 1 Til yCount
Hvis jeg <> yFilterstr1 Og jeg <> yfilterstr2 Så
ActiveSheet.PivotTables("Order_Comp_B2C_Disp").PivotFields("Ugenummer").PivotItems(I).Visible = False
ActiveSheet.PivotTables("Order_Comp_B2B_Disp").PivotFields("Ugenummer").PivotItems(I).Visible = False
Else
ActiveSheet.PivotTables("Order_Comp_B2C_Disp").PivotFields("Ugenummer").PivotItems(I).Visible = True
ActiveSheet.PivotTables("Order_Comp_B2B_Disp").PivotFields("Ugenummer").PivotItems(I).Visible = True
End If
Næste

End Sub
Denne kommentar blev minimeret af moderatoren på webstedet
Skift værdier i Array(), Worksheets() og Intersect()



**Find disse og skift dem**
Arknavn
E1
Pivottabel1
Pivottabel2
Pivottabel3




Privat Sub Worksheet_Change (ByVal Target As Range)
'Opdater af Extendoffice 20180702
Dim xPTable Som pivottabel
Dim xPFile Som PivotField

Dim xPTabled som pivottabel
Dim xPFiled Som PivotField

Dim xStr As String



On Error Resume Next

'리스트 만들기
Dim listArray() Som variant
listArray = Array("Pivottabel1", "Pivottabel2", "Pivottabel3")



Hvis Intersect(Target, Range("E1")) er intet, så Afslut Sub
Application.ScreenUpdating = False

For i = 0 til UBound(listArray)

Indstil xPTable = Worksheets("SheetName").PivotTables(listArray(i))
Indstil xPFile = xPTable.PivotFields("Company_ID")

xStr = Target.Text
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr



Næste

Application.ScreenUpdating = True



End Sub
Denne kommentar blev minimeret af moderatoren på webstedet
Hej,

Koden fungerer fint for mig. Jeg er dog ikke i stand til at få pivottabellen til at opdatere filtermålet automatisk. Målet i mit tilfælde er en formel [DATE(D18,S14,C18)]. Koden virker kun, når jeg dobbeltklikker på målcellen og trykker enter.

Tak
Denne kommentar blev minimeret af moderatoren på webstedet
Hej,

Denne kode fungerer perfekt. Men jeg er ikke i stand til at få koden til at opdatere pivottabellen automatisk. Målværdien for mig er en formel (=DATO(D18,..,..)), som ændrer sig alt efter hvad der er valgt ved D18. For at den skal opdatere pivottabellen, skal jeg dobbeltklikke på målcellen og trykke på enter. Er der en vej udenom?

Tak
Denne kommentar blev minimeret af moderatoren på webstedet
Hej ST,
Antag, at din målværdi er i H6, og den ændrer sig afhængigt af værdien i D18. At filtrere en pivottabel baseret på denne målværdi. Følgende VBA-kode kan hjælpe. Prøv det.
Private Sub Worksheet_Change(ByVal Target As Range)
'Updated by Extendoffice 2022/07/22
Dim xPTable As PivotTable
Dim xPFile As PivotField
Dim xStr As String
Dim xBoolean As Boolean
Dim xItsRG As Range
Dim xDDs As Range
Dim xDs As Range
On Error Resume Next

xBoolean = False
Set xRg = Range("h6")

Set xItsRG = Intersect(Target, xRg)
Set xDDs = Intersect(Target.DirectDependents, xRg)
Set xDs = Intersect(Target.Dependents, xRg)
If Not (xItsRG Is Nothing) Then
    xBoolean = True
ElseIf Not (xDDs Is Nothing) Then
    xBoolean = True
ElseIf Not (xDs Is Nothing) Then
    xBoolean = True
End If


If Not xBoolean Then Exit Sub

Application.ScreenUpdating = False
Set xPTable = Worksheets("Sheet1").PivotTables("Pivot Table 1")
Set xPFile = xPTable.PivotFields("Category")
xStr = Target.Text
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr
Application.ScreenUpdating = True

End Sub
Denne kommentar blev minimeret af moderatoren på webstedet
Hej Krysal,

Jeg tilføjede en linje på koden: Dim xRg As Range

Koden nulstiller ikke automatisk datoerne, når målet ændres. Jeg har en excel-fil, der replikerer det, jeg forsøger at gøre, men jeg er ikke i stand til at tilføje vedhæftede filer på denne hjemmeside. D3 (mål = DATO(A15,B15,C15)) har en ligning knyttet til A15, B15 og C15. Når en værdi på A15, B15 og C15 ændres, nulstilles pivottabellen til intet filter. Kan du hjælpe mig med dette?
Denne kommentar blev minimeret af moderatoren på webstedet
Hej ST,
Jeg forstår ikke helt hvad du mener. I dit tilfælde bruges værdien af ​​målcelle D3 til at filtrere pivottabellen. Formlen i målcellen D3 refererer til værdierne i cellerne A15, B15 og C15, som vil ændre sig i henhold til værdierne i referencecellerne. Når en værdi på A15, B15 og C15 ændres, vil pivottabellen automatisk blive filtreret, hvis værdien i målcellen opfylder pivottabellens filterbetingelser. Hvis værdien i målcellen ikke opfylder pivottabellens filtreringskriterier, nulstilles pivottabellen automatisk til ingen filtrering.
Denne kommentar blev minimeret af moderatoren på webstedet
Jeg er ikke sikker på, om der er en måde at dele en excel-fil med dig på. Hvis min målværdi, som er en dato, ændres i henhold til ændringer i andre celler. Jeg er nødt til at dobbeltklikke på målcellen og trykke på enter (som du ville efter at have indtastet en formel i en celle) for at opdatere pivottabellen
Denne kommentar blev minimeret af moderatoren på webstedet
Hej Sagar T,
Koden er blevet opdateret. Prøv det. tak for din tilbagemelding.
Glem ikke at ændre navnene på regnearket, pivottabellen og filteret i koden. Eller du kan downloade følgende uploadede projektmappe til test.

Private Sub Worksheet_Change(ByVal Target As Range)
'Updated by Extendoffice 20220805
Dim xPTable As PivotTable
Dim xPFile As PivotField
Dim xStr As String
Dim xBoolean As Boolean
Dim xItsRG As Range
Dim xDDs As Range
Dim xDs As Range
On Error Resume Next

xBoolean = False
Set xRg = Range("D3")

Set xItsRG = Intersect(Target, xRg)
Set xDDs = Intersect(Target.DirectDependents, xRg)
Set xDs = Intersect(Target.Dependents, xRg)
If Not (xItsRG Is Nothing) Then
    xBoolean = True
ElseIf Not (xDDs Is Nothing) Then
    xBoolean = True
ElseIf Not (xDs Is Nothing) Then
    xBoolean = True
End If


If Not xBoolean Then Exit Sub
xStr = Format(xRg.Text, "m/d/yyyy")
Application.ScreenUpdating = False
Set xPTable = Worksheets("Sheet2").PivotTables("PivotTable1")
Set xPFile = xPTable.PivotFields("Date")
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr
Application.ScreenUpdating = True

End Sub
Denne kommentar blev minimeret af moderatoren på webstedet
find disse og skift dem i Array(),Intersect(), Worksheets(), PivotFields()

Pivottabel1
Pivottabel2
Pivottabel3
Pivottabel4
H1
Arknavn
Feltnavn




Private Sub Worksheet_Change(ByVal Target As Range)
'Update by Extendoffice 20180702
    Dim xPTable As PivotTable
    Dim xPFile As PivotField
    Dim xPTabled As PivotTable
    Dim xPFiled As PivotField
    Dim xStr As String
    On Error Resume Next
    '리스트 만들기
    Dim listArray() As Variant
    listArray = Array("PivotTable1", "PivotTable2", "PivotTable3", "PivotTable4")
    If Intersect(Target, Range("H1")) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    For i = 0 To UBound(listArray)
        Set xPTable = Worksheets("SheetName").PivotTables(listArray(i))
        Set xPFile = xPTable.PivotFields("FieldName")
        'MsgBox (listArray(i))
        xStr = Target.Text
        xPFile.ClearAllFilters
        xPFile.CurrentPage = xStr
    Next
        Application.ScreenUpdating = True
End Sub
Der er endnu ingen kommentarer her
Efterlad dine kommentarer
Sender som gæst
×
Bedøm dette indlæg:
0   Tegn
Foreslåede steder