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

Hur länkar man pivottabelfilter till en viss cell i Excel?

Om du vill länka ett pivottabelfilter till en viss cell och göra pivottabellen filtrerad baserat på cellvärdet kan metoden i den här artikeln hjälpa dig.

Länka pivottabelfiltret till en viss cell med VBA-kod


Länka pivottabelfiltret till en viss cell med VBA-kod

Pivottabellen som du kommer att länka dess filterfunktion till ett cellvärde bör innehålla ett filterfält (namnet på filterfältet spelar en viktig roll i följande VBA-kod).

Ta nedanstående pivottabell som ett exempel. Filterfältet i pivottabellen kallas Kategori, och den innehåller två värden ”Kostnader"Och"Försäljning”. Efter att ha kopplat pivottabelfiltret till en cell bör de cellvärden som du kommer att använda för att filtrera pivottabellen vara "Utgifter" och "Försäljning".

1. Välj den cell (här väljer jag cell H6) som du kommer att länka till Pivot Tabells filterfunktion och ange ett av filtervärdena i cellen i förväg.

2. Öppna kalkylbladet innehåller pivottabellen som du kommer att länka till cellen. Högerklicka på arkfliken och välj Visa kod från snabbmenyn. Se skärmdump:

3. I Microsoft Visual Basic för applikationer kopiera under VBA-koden till kodfönstret.

VBA-kod: Länk pivottabelfilter till en viss cell

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

Anmärkningar:

1) "Sheet1”Är namnet på det öppnade kalkylbladet.
2) "Pivottabell2”Är namnet på pivottabellen, du kommer att länka dess filterfunktion till en cell.
3) Filtreringsfältet i pivottabellen kallas "Kategori".
4) Den refererade cellen är H6. Du kan ändra dessa variabla värden baserat på dina behov.

4. tryck på andra + Q för att stänga Microsoft Visual Basic för applikationer fönster.

Nu är filterfunktionen i pivottabellen kopplad till cell H6.

Uppdatera cellen H6, sedan filtreras motsvarande data i pivottabellen ut baserat på det befintliga värdet. Se skärmdump:

När du ändrar cellvärdet ändras de filtrerade data i pivottabellen automatiskt. Se skärmdump:


Välj enkelt hela rader baserat på cellvärde i en certian-kolumn:

Du har nu möjlighet Välj specifika celler nytta av Kutools för Excel kan hjälpa dig att snabbt välja hela rader baserat på cellvärde i en certian-kolumn i Excel som visas nedan. När du har valt alla rader baserat på cellvärde kan du manuellt flytta eller kopiera dem till en ny plats som du behöver i Excel.
Ladda ner och prova nu! (30- dag gratis spår)


Relaterade artiklar:


De bästa Office-produktivitetsverktygen

Kutools för Excel löser de flesta av dina problem och ökar din produktivitet med 80%

  • återanvändning: Sätt snabbt i komplexa formler, diagram och allt som du har använt tidigare; Kryptera celler med lösenord; Skapa e-postlista och skicka e-post ...
  • Super Formula Bar (enkelt redigera flera rader med text och formel); Läslayout (enkelt läsa och redigera ett stort antal celler); Klistra in i filtrerat intervall...
  • Sammanfoga celler / rader / kolumner utan att förlora data; Delat cellinnehåll; Kombinera duplicerade rader / kolumner... Förhindra duplicerade celler; Jämför intervall...
  • Välj Duplicera eller Unikt Rader; Välj tomma rader (alla celler är tomma); Super Find och Fuzzy Find i många arbetsböcker; Slumpmässigt val ...
  • Exakt kopia Flera celler utan att ändra formelreferens; Skapa referenser automatiskt till flera ark; Sätt in kulor, Kryssrutor och mer ...
  • Extrahera text, Lägg till text, ta bort efter position, Ta bort mellanslag; Skapa och skriva ut personsökningstalsatser; Konvertera mellan celler innehåll och kommentarer...
  • Superfilter (spara och tillämpa filterscheman på andra ark); Avancerad sortering efter månad / vecka / dag, frekvens och mer; Specialfilter av fet, kursiv ...
  • Kombinera arbetsböcker och arbetsblad; Sammanfoga tabeller baserat på nyckelkolumner; Dela data i flera ark; Batchkonvertera xls, xlsx och PDF...
  • Mer än 300 kraftfulla funktioner. Stöder Office / Excel 2007-2021 och 365. Stöder alla språk. Enkel implementering i ditt företag eller organisation. Fullständiga funktioner 30 dagars gratis provperiod. 60 dagars pengarna tillbaka-garanti.
kte-flik 201905

Fliken Office ger ett flikgränssnitt till Office och gör ditt arbete mycket enklare

  • Aktivera flikredigering och läsning i Word, Excel, PowerPoint, Publisher, Access, Visio och Project.
  • Öppna och skapa flera dokument i nya flikar i samma fönster, snarare än i nya fönster.
  • Ökar din produktivitet med 50 % och minskar hundratals musklick för dig varje dag!
officetab botten
Sortera kommentarer efter
Kommentarer (36)
Inga betyg än. Bli först med att betygsätta!
Denna kommentar minimerades av moderatoren på webbplatsen
hur man gör det på flera fält eftersom det bara finns ett mål i koden
Denna kommentar minimerades av moderatoren på webbplatsen
Hej Frank
Sory kan inte hjälpa dig med det.
Denna kommentar minimerades av moderatoren på webbplatsen
Vad händer om cellen som är länkad till pivottabellen, i det här fallet H6, finns på ett annat kalkylblad? Hur ändrar den koden?
Denna kommentar minimerades av moderatoren på webbplatsen
vad händer om jag har mer än 1 pivottabell och länkar till 1 cell. Hur ska jag ändra koden?
Denna kommentar minimerades av moderatoren på webbplatsen
Hej Jeri,
Jag kan tyvärr inte hjälpa dig med det. Välkommen att ställa alla frågor i vårt forum: https://www.extendoffice.com/forum.html för att få mer Excel-stöd från Excel-proffs eller andra Excel-fans.
Denna kommentar minimerades av moderatoren på webbplatsen
hitta dessa och ändra dem i Array(), Intersect(), Worksheets(), PivotFields()

Pivottabell1
Pivottabell2
Pivottabell3
Pivottabell4
H1
Bladnamn
Fält namn




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
Denna kommentar minimerades av moderatoren på webbplatsen
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...! Bra publicering, hur använder jag filtret i två eller flera pivottabeller ...? Tack på förhand.
Denna kommentar minimerades av moderatoren på webbplatsen
Hej Gilmar Alves,
Jag kan tyvärr inte hjälpa dig med det. Välkommen att ställa alla frågor i vårt forum: https://www.extendoffice.com/forum.html för att få mer Excel-stöd från Excel-proffs eller andra Excel-fans.
Denna kommentar minimerades av moderatoren på webbplatsen
Har någon listat ut länkningsfrågan med flera pivottabeller?
Denna kommentar minimerades av moderatoren på webbplatsen
Ändra värden i Array(), Worksheets() och Intersect()



**Hitta dessa och ändra dem**
Bladnamn
E1
Pivottabell1
Pivottabell2
Pivottabell3




Privata delarkivsförändring (ByVal-mål som område)
'Uppdatera av Extendoffice 20180702
Dim xPTable Som pivottabell
Dim xPFile som pivotfält

Dim xPTabled som pivottabell
Dim xPFiled Som PivotField

Dim xStr As String



On Error Resume Next

'리스트 만들기
Dim listArray() Som variant
listArray = Array("Pivottabell1", "Pivottabell2", "Pivottabell3")



Om Intersect(Target, Range("E1")) är ingenting, avsluta Sub
Application.ScreenUpdating = False

För i = 0 Till UBound(listArray)

Set xPTable = Worksheets("SheetName").PivotTables(listArray(i))
Ställ in xPFile = xPTable.PivotFields("Company_ID")

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



Nästa

Application.ScreenUpdating = True



End Sub
Denna kommentar minimerades av moderatoren på webbplatsen
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.

Vilken passaggio manca nella descrizione sopra?
Denna kommentar minimerades av moderatoren på webbplatsen
Hej,
Fick du någon felmeddelande? Jag behöver veta mer specifikt om ditt problem, till exempel din Excel-version. Och om du inte har något emot det, försök att skapa din data i en ny arbetsbok och försök igen, eller ta en skärmdump av din data och ladda upp den här.
Denna kommentar minimerades av moderatoren på webbplatsen
Hej,

Försökte få detta att fungera för kolumnfiltret men verkar inte fungera. Behöver jag en annan kod för det?

Tack
Denna kommentar minimerades av moderatoren på webbplatsen
Hej Justin,
Fick du någon felmeddelande? Jag behöver veta mer specifikt om ditt problem.
Innan du använder koden, glöm inte att ändra "arkets namn""namnet på pivottabellen""namnet på filtret för pivottabellen" och den cellen du vill filtrera pivottabellen baserat på (se scenshot).
https://www.extendoffice.com/images/stories/comments/comment-picture-zxm/4.png
Denna kommentar minimerades av moderatoren på webbplatsen
Hej Crystal,

Tack för hjälpen. Problemet är att funktionen inte gör något av någon anledning. Lite förtydligande:

Pivotnamn: Order_Comp_B2C
Bladnamn: Beräkningsblad
Filternamn: Veckanummer (jag ändrade detta namn från vad som var "Utsändningsveckanummer" i datafilen)
Cell att byta: O26 och O27 (detta bör gå inom intervallet)

I denna pivot försöker jag få filtret ändrat för kolumnerna, jag har ingenting i filterområdet i PivotTable Fields-menyn.

min kod är:

Privata delarkivsförändring (ByVal-mål som område)
'Uppdatera av Extendoffice 20180702
Dim xPTable Som pivottabell
Dim xPFile som pivotfält
Dim xStr As String
On Error Resume Next
Om Intersect(Target, Range("O26")) är ingenting, avsluta Sub
Application.ScreenUpdating = False
Set xPTable = Worksheets("Beräkningsblad"). Pivottabeller("Order_Comp_B2C")
Ställ in xPFile = xPTable.PivotFields("Veckans nummer")
xStr = Target.Text
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr
Application.ScreenUpdating = True
End Sub

Tack,

Justin
Denna kommentar minimerades av moderatoren på webbplatsen
Hej Justin Teeuw,
Jag har ändrat Pivotnamn, bladnamn, filternamn och cell för att ändra till de villkor du nämnde ovan och provade VBA-koden du angav, fungerar det bra i mitt fall. Se följande GIF eller den bifogade arbetsboken.
Har du något emot att skapa en ny arbetsbok och prova koden igen?
https://www.extendoffice.com/images/stories/comments/comment-picture-zxm/6.gif
Denna kommentar minimerades av moderatoren på webbplatsen
Hej Crystal,

Bifogat en skärmdump av pivoten, den röda rutan är filtret jag skulle vilja ändra baserat på cellvärdet.

Helst skulle jag vilja använda ett cellintervall som indikerar flera veckonummer.

Tack,

Justin
Denna kommentar minimerades av moderatoren på webbplatsen
Hej Justin,
Förlåt att jag inte såg skärmdumpen du bifogade på sidan. Kanske är det något fel på sidan.
Om du fortfarande behöver lösa problemet, maila mig via zxm@addin99.com. Beklagar olägenheten.
Denna kommentar minimerades av moderatoren på webbplatsen
Hej Justin Teeuw!
Försök med följande VBA-kod. Hoppas jag kan hjälpa till.

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
Denna kommentar minimerades av moderatoren på webbplatsen
Jag använde det för en normal Excel och det fungerade. Men jag kunde inte använda det för en olap kalkylblad. jag kanske behöver ändra det lite?
Denna kommentar minimerades av moderatoren på webbplatsen
Hej maziaritib4 TIB,
Metoden är endast tillgänglig för Microsoft Excel. Beklagar olägenheten.
Denna kommentar minimerades av moderatoren på webbplatsen
Hej Justin,

Detta har fungerat perfekt, men jag undrar om denna regel kan tillämpas på flera pivottabeller inom samma ark?

Tack,
James
Denna kommentar minimerades av moderatoren på webbplatsen
Hej James,

Ja detta är möjligt, koden jag använde för detta är (4 pivoter och 2 cellreferenser):

Privata delarkivsförändring (ByVal-mål som område)
Dim I som heltal
Dim xFilterStr1, xFilterStr2, yFilterstr1, yfilterstr2 Som sträng
On Error Resume Next
Om Intersect(Target, Range("O26:P27")) är ingenting, avsluta då

xFilterStr1 = Range("O26").Värde
xFilterStr2 = Range("O27").Värde
yFilterstr1 = Range("p26").Värde
yfilterstr2 = Range("p27").Värde
ActiveSheet.PivotTables("Order_Comp_B2C_Crea").PivotFields("Veckans nummer"). _
ActiveSheet.PivotTables("Order_Comp_B2B_Crea").PivotFields("Veckans nummer"). _
ActiveSheet.PivotTables("Order_Comp_B2C_Disp").PivotFields("Veckans nummer"). _
ActiveSheet.PivotTables("Order_Comp_B2B_Disp").PivotFields("Veckans nummer"). _
ClearAllFilters

Om xFilterStr1 = "" Och xFilterStr2 = "" Och yFilterstr1 = "" Och yfilterstr2 = "" Avsluta Sub
ActiveSheet.PivotTables("Order_Comp_B2C_Crea").PivotFields("Veckans nummer"). _
ActiveSheet.PivotTables("Order_Comp_B2B_Crea").PivotFields("Veckans nummer"). _
ActiveSheet.PivotTables("Order_Comp_B2C_Disp").PivotFields("Veckans nummer"). _
ActiveSheet.PivotTables("Order_Comp_B2B_Disp").PivotFields("Veckans nummer"). _
EnableMultiplePageItems = True

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

För I = 1 Till xCount
Om jag <> xFilterStr1 Och jag <> xFilterStr2 Då
ActiveSheet.PivotTables("Order_Comp_B2C_Crea").PivotFields("Veckans nummer").PivotItems(I).Visible = False
ActiveSheet.PivotTables("Order_Comp_B2B_Crea").PivotFields("Veckans nummer").PivotItems(I).Visible = False
annars
ActiveSheet.PivotTables("Order_Comp_B2C_Crea").PivotFields("Veckans nummer").PivotItems(I).Visible = True
ActiveSheet.PivotTables("Order_Comp_B2B_Crea").PivotFields("Veckans nummer").PivotItems(I).Visible = True
End If
Nästa

För I = 1 Till yCount
Om jag <> yFilterstr1 Och jag <> yfilterstr2 Då
ActiveSheet.PivotTables("Order_Comp_B2C_Disp").PivotFields("Veckans nummer").PivotItems(I).Visible = False
ActiveSheet.PivotTables("Order_Comp_B2B_Disp").PivotFields("Veckans nummer").PivotItems(I).Visible = False
annars
ActiveSheet.PivotTables("Order_Comp_B2C_Disp").PivotFields("Veckans nummer").PivotItems(I).Visible = True
ActiveSheet.PivotTables("Order_Comp_B2B_Disp").PivotFields("Veckans nummer").PivotItems(I).Visible = True
End If
Nästa

End Sub
Denna kommentar minimerades av moderatoren på webbplatsen
Ändra värden i Array(), Worksheets() och Intersect()



**Hitta dessa och ändra dem**
Bladnamn
E1
Pivottabell1
Pivottabell2
Pivottabell3




Privata delarkivsförändring (ByVal-mål som område)
'Uppdatera av Extendoffice 20180702
Dim xPTable Som pivottabell
Dim xPFile som pivotfält

Dim xPTabled som pivottabell
Dim xPFiled Som PivotField

Dim xStr As String



On Error Resume Next

'리스트 만들기
Dim listArray() Som variant
listArray = Array("Pivottabell1", "Pivottabell2", "Pivottabell3")



Om Intersect(Target, Range("E1")) är ingenting, avsluta Sub
Application.ScreenUpdating = False

För i = 0 Till UBound(listArray)

Set xPTable = Worksheets("SheetName").PivotTables(listArray(i))
Ställ in xPFile = xPTable.PivotFields("Company_ID")

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



Nästa

Application.ScreenUpdating = True



End Sub
Denna kommentar minimerades av moderatoren på webbplatsen
Hallå,

Koden fungerar bra för mig. Jag kan dock inte få pivottabellen att uppdatera filtermålet automatiskt. Målet i mitt fall är en formel [DATE(D18,S14,C18)]. Koden fungerar bara när jag dubbelklickar på målcellen och trycker på enter.

Tack
Denna kommentar minimerades av moderatoren på webbplatsen
Hallå,

Denna kod fungerar perfekt. Men jag kan inte få koden för att uppdatera pivottabellen automatiskt. Målvärdet för mig är en formel (=DATE(D18,..,..)) som ändras beroende på vad som väljs vid D18. För att den ska uppdatera pivottabellen måste jag dubbelklicka på målcellen och trycka på enter. Finns det en väg runt det?

Tack
Denna kommentar minimerades av moderatoren på webbplatsen
Hej ST,
Anta att ditt målvärde är i H6 och det ändras beroende på värdet i D18. Att filtrera en pivottabell baserat på detta målvärde. Följande VBA-kod kan hjälpa. Vänligen ge det ett försök.
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
Denna kommentar minimerades av moderatoren på webbplatsen
Hej Crystal,

Jag lade till en rad i koden: Dim xRg As Range

Koden återställer inte automatiskt datumen när målet ändras. Jag har en excel-fil som replikerar det jag försöker göra, men jag kan inte lägga till bilagor på den här webbplatsen. D3 (mål = DATUM(A15,B15,C15)) har en ekvation kopplad till A15, B15 och C15. När något värde på A15, B15 och C15 ändras återställs pivottabellen till inget filter. Kan du hjälpa mig med detta?
Denna kommentar minimerades av moderatoren på webbplatsen
Hej ST,
Jag förstår inte riktigt vad du menar. I ditt fall används värdet för målcell D3 för att filtrera pivottabellen. Formeln i målcellen D3 refererar till värdena för cellerna A15, B15 och C15, som kommer att ändras enligt värdena i referenscellerna. När något värde på A15, B15 och C15 ändras, kommer pivottabellen att filtreras automatiskt om värdet i målcellen uppfyller filtervillkoren för pivottabellen. Om värdet i målcellen inte uppfyller pivottabellens filtreringskriterier kommer pivottabellen automatiskt att återställas till ingen filtrering.
Denna kommentar minimerades av moderatoren på webbplatsen
Jag är inte säker på om det finns ett sätt att dela en excel-fil med dig. Om mitt målvärde, som är ett datum, ändras enligt ändringar i andra celler. Jag måste dubbelklicka på målcellen och trycka på enter (som du skulle göra efter att ha angett en formel i en cell) för att uppdatera pivottabellen
Denna kommentar minimerades av moderatoren på webbplatsen
Hej Sagar T,
Koden har uppdaterats. Vänligen ge det ett försök. Tack för din feedback.
Glöm inte att ändra namnen på kalkylbladet, pivottabellen och filtret i koden. Eller så kan du ladda ner följande uppladdade arbetsbok för testning.

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
Denna kommentar minimerades av moderatoren på webbplatsen
hitta dessa och ändra dem i Array(), Intersect(), Worksheets(), PivotFields()

Pivottabell1
Pivottabell2
Pivottabell3
Pivottabell4
H1
Bladnamn
Fält namn




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
Denna kommentar minimerades av moderatoren på webbplatsen
Hur kan du använda 2 bilder och 2 bilder? а не 1 как в примере?
Denna kommentar minimerades av moderatoren på webbplatsen
Hej Алексей,

Kontrollera om VBA-koden i den här kommentaren #38754 kan hjälpa till.
Denna kommentar minimerades av moderatoren på webbplatsen
Kan du använda H6 när du är hemma? как это сделать? подскажите пожалуйста.
Denna kommentar minimerades av moderatoren på webbplatsen
Hej Алексей,

Du behöver inte ändra koden, lägg bara till VBA-koden i kalkylbladet för cellen du vill referera till.
Till exempel, om du vill filtrera en pivottabell med namnet "Pivottabell1"i Sheet2 baserat på cellens värde H6 in Sheet3, högerklicka på Sheet3 kalkylbladsfliken, klicka Visa kod från högerklicksmenyn och lägg sedan till koden i Blad3 (kod) fönster.
Det finns inga kommentarer här ännu
Lämna dina kommentarer
Postar som gäst
×
Betygsätt detta inlägg:
0   Tecken
Föreslagna platser

Följ oss

Copyright © 2009 - www.extendoffice.com. | Alla rättigheter förbehållna. Drivs av ExtendOffice. | | Sitemap
Microsoft och Office-logotypen är varumärken eller registrerade varumärken som tillhör Microsoft Corporation i USA och / eller andra länder.
Skyddad av Sectigo SSL