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

Hogyan lehet összekapcsolni a Pivot Table szűrőt az Excel egy bizonyos cellájával?

Ha egy kimutató tábla szűrőt szeretne összekapcsolni egy bizonyos cellával, és a kimutatási táblázatot a cella értéke alapján szeretné szűrni, akkor ebben a cikkben szereplő módszer segíthet.

Csatlakoztassa a Pivot Table szűrőt egy bizonyos VBA kóddal rendelkező cellához


Csatlakoztassa a Pivot Table szűrőt egy bizonyos VBA kóddal rendelkező cellához

A Pivot-táblának, amelynek szűrőfunkcióját egy cellaértékhez kapcsolja, tartalmaznia kell egy szűrőmezőt (a szűrőmező neve fontos szerepet játszik a következő VBA-kódban).

Vegyük példaként az alábbi kimutatási táblázatot. A Pivot-táblázat szűrőmezőjét hívjuk meg Kategória, és két értéket tartalmaz:Költségek"És"Értékesítés”. Miután összekapcsolta a Pivot Table szűrőt egy cellával, a Pivot Table szűrőre alkalmazandó cellaértékeknek „Költségek” és „Értékesítés” értékeknek kell lenniük.

1. Kérjük, válassza ki azt a cellát (itt a H6 cellát választom), amelyet összekapcsol a Pivot Table szűrőfunkciójával, és előzetesen adja meg az egyik szűrőértéket a cellában.

2. Nyissa meg azt a munkalapot, amely tartalmazza azt a kimutatási táblázatot, amelyet a cellához fog kapcsolni. Kattintson a jobb gombbal a lap fülre, és válassza a lehetőséget Kód megtekintése a helyi menüből. Lásd a képernyőképet:

3. Ban,-ben Microsoft Visual Basic for Applications ablakba, másolja a VBA kód alatt a Kód ablakba.

VBA kód: A Pivot Table szűrő összekapcsolása egy bizonyos cellával

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

Megjegyzések:

1) "Sheet1”A megnyitott munkalap neve.
2) "PivotTable2”Annak a kimutató táblának a neve, amelynek szűrőfunkcióját összekapcsolja egy cellával.
3) A pivot tábla szűrőmezője a következő:Kategória".
4) A hivatkozott cella H6. Ezeket a változó értékeket az Ön igényei szerint módosíthatja.

4. megnyomni a más + Q gombok a Microsoft Visual Basic for Applications ablak.

Most a Pivot tábla szűrési funkciója összekapcsolódik a H6 cellával.

Frissítse a H6 cellát, majd a Pivot Table megfelelő adatait kiszűri a meglévő érték alapján. Lásd a képernyőképet:

A cellaérték megváltoztatásakor a kimutatott táblázat szűrt adatai automatikusan megváltoznak. Lásd a képernyőképet:


Könnyen kiválaszthatja a teljes sorokat a certikus oszlop cellájának értéke alapján:

A Válassza a Specifikus cellák lehetőséget hasznossága Kutools az Excel számára segíthet gyorsan kiválasztani a teljes sorokat az cellák értéke alapján az Excel cert-oszlopában, az alábbi képernyőképen. Miután az összes sort cellaérték alapján választotta ki, manuálisan áthelyezheti vagy átmásolhatja őket egy új helyre, amire az Excelben szüksége van.
Töltse le és próbálja ki most! (30-napos ingyenes túra)


Kapcsolódó cikkek:


A legjobb irodai termelékenységi eszközök

A Kutools for Excel megoldja a legtöbb problémát, és 80% -kal növeli a termelékenységet

  • újrafelhasználás: Gyorsan helyezze be összetett képletek, diagramok és bármi, amit korábban használt; Cellák titkosítása jelszóval; Levelezőlista létrehozása és e-maileket küldeni ...
  • Szuper Formula Bár (könnyedén szerkeszthet több szöveget és képletet); Olvasás elrendezés (könnyen olvasható és szerkeszthető nagyszámú cella); Beillesztés a Szűrt tartományba...
  • Cellák / sorok / oszlopok egyesítése az adatok elvesztése nélkül; Osztott cellák tartalma; Kombinálja a duplikált sorokat / oszlopokat... megakadályozza az ismétlődő cellákat; Hasonlítsa össze a tartományokat...
  • Válassza a Másolat vagy az Egyedi lehetőséget Sorok; Válassza az Üres sorok lehetőséget (az összes cella üres); Super Find és Fuzzy Find sok munkafüzetben; Véletlenszerű kiválasztás ...
  • Pontos másolás Több cella a képletreferencia megváltoztatása nélkül; Automatikus referenciák létrehozása több lapra; Helyezze be a golyókat, Jelölőnégyzetek és még sok más ...
  • Kivonat szöveg, Szöveg hozzáadása, Eltávolítás pozíció szerint, Hely eltávolítása; Hozz létre és nyomtasson személyhívó részösszegeket; Konvertálás a cellatartalom és a megjegyzések között...
  • Szuper szűrő (mentse el és alkalmazza a szűrősémákat más lapokra); Haladó rendezés hónap / hét / nap, gyakoriság és egyebek szerint; Speciális szűrő félkövér, dőlt betűvel ...
  • Kombinálja a munkafüzeteket és a munkalapokat; Táblázatok egyesítése kulcsoszlopok alapján; Az adatok felosztása több lapra; Kötegelt konvertálás xls, xlsx és PDF...
  • Több mint 300 hatékony funkció. Támogatja az Office / Excel 2007-2021 és 365 verziókat. Minden nyelvet támogat. Könnyű üzembe helyezés vállalatában vagy szervezetében. Teljes funkciók 30 napos ingyenes próbaverzió. 60 napos pénzvisszafizetési garancia.
kte lap 201905

Az Office fül a füles felületet hozza az Office-ba, és sokkal könnyebbé teszi a munkáját

  • Füles szerkesztés és olvasás engedélyezése Wordben, Excelben és PowerPointban, Publisher, Access, Visio és Project.
  • Több dokumentum megnyitása és létrehozása ugyanazon ablak új lapjain, mint új ablakokban.
  • 50% -kal növeli a termelékenységet, és naponta több száz kattintással csökkenti az egér kattintását!
officetab alja
A megjegyzések rendezése szerint
Hozzászólások (36)
Még nincs értékelés. Legyen Ön az első, aki értékel!
A weboldal moderátora ezt a megjegyzést minimalizálta
hogyan kell ezt megtenni multi;tiple mezőben, mivel a kódban csak egy cél van
A weboldal moderátora ezt a megjegyzést minimalizálta
Hi Frank
Sorry ebben nem tud segíteni.
A weboldal moderátora ezt a megjegyzést minimalizálta
Mi a teendő, ha a kimutatástáblázathoz kapcsolódó cella, ebben az esetben a H6, egy másik munkalapon van? Hogyan változtatja meg a kódot?
A weboldal moderátora ezt a megjegyzést minimalizálta
mi van akkor, ha 1-nél több pivot táblám van, és 1 cellára kell hivatkoznom. Hogyan módosíthatom a kódot?
A weboldal moderátora ezt a megjegyzést minimalizálta
Szia Jeri,
Sajnos ebben nem tudok segíteni. Üdvözöljük, ha bármilyen kérdést feltehet fórumunkon: https://www.extendoffice.com/forum.html hogy több Excel támogatást kapjon az Excel professzionális vagy más Excel rajongóktól.
A weboldal moderátora ezt a megjegyzést minimalizálta
keresse meg ezeket és változtassa meg az Array(), Intersect(), Worksheets(), PivotFields()

PivotTable1
PivotTable2
PivotTable3
PivotTable4
H1
Lapnév
Mező neve




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
A weboldal moderátora ezt a megjegyzést minimalizálta
Boa tarde...! Ótima publicação, como faço para utilizar o filtro em duas ou mais tabelas dinâmicas...? Agradeço desde já.

Jó napot...! Nagyszerű közzététel, hogyan használhatom a szűrőt két vagy több kimutatásban...? Előre is köszönöm.
A weboldal moderátora ezt a megjegyzést minimalizálta
Szia Gilmar Alves!
Sajnos ebben nem tudok segíteni. Üdvözöljük, ha bármilyen kérdést feltehet fórumunkon: https://www.extendoffice.com/forum.html hogy több Excel támogatást kapjon az Excel professzionális vagy más Excel rajongóktól.
A weboldal moderátora ezt a megjegyzést minimalizálta
Valaki kitalálta a többszörös pivot tábla összekapcsolási kérdést?
A weboldal moderátora ezt a megjegyzést minimalizálta
Az Array(), a Worksheets() és a Intersect() értékeinek módosítása



**Keresse meg ezeket, és változtassa meg**
Lapnév
E1
PivotTable1
PivotTable2
PivotTable3




Private Sub Worksheet_Change (ByVal Target mint Range)
'Frissítés Extendoffice 20180702
Dim xPTable PivotTable-ként
Dim xPFile PivotFieldként

Dim xPTabled PivotTable-ként
Dim xPFiled As PivotField

Dim xStr As String



On Error Resume Next

'리스트 만들기
Dim listArray() As Variant
listArray = Tömb("PivotTable1", "PivotTable2", "PivotTable3")



Ha a metszéspont(cél, tartomány("E1")) semmi, akkor lépjen ki a Sub
Application.ScreenUpdating = Hamis

Ha i = 0 - UBound(listArray)

Set xPTable = Worksheets("SheetName").PivotTables(listArray(i))
Állítsa be az xPFile = xPTable.PivotFields("Cégazonosító")

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



Következő

Application.ScreenUpdating = Igaz



End Sub
A weboldal moderátora ezt a megjegyzést minimalizálta
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.

Quale passaggio manca nella decrizione sopra?
A weboldal moderátora ezt a megjegyzést minimalizálta
Szia,
Kaptál valamilyen hibaüzenetet? Pontosabban kell tudnom a problémájáról, például az Excel verziójáról. És ha nem bánja, próbálja meg létrehozni az adatokat egy új munkafüzetben, és próbálkozzon újra, vagy készítsen képernyőképet az adatokról, és töltse fel ide.
A weboldal moderátora ezt a megjegyzést minimalizálta
Szia,

Megpróbáltam működésre bírni az oszlopszűrőt, de úgy tűnik, nem működik. Kell ehhez másik kód?

Kösz
A weboldal moderátora ezt a megjegyzést minimalizálta
Szia Justin,
Kaptál valamilyen hibaüzenetet? Pontosabban kell tudnom a problémádról.
A kód alkalmazása előtt ne felejtse el módosítani a "a lap neve""a pivot tábla neve""a pivot tábla szűrőjének neve" és a sejt alapján szeretné szűrni a pivot táblát (lásd a jelenetképet).
https://www.extendoffice.com/images/stories/comments/comment-picture-zxm/4.png
A weboldal moderátora ezt a megjegyzést minimalizálta
Szia Crystal,

Köszönöm a segítséget. A probléma az, hogy a funkció valamiért nem csinál semmit. Egy kis pontosítás:

Pivot neve: Order_Comp_B2C
Lap neve: Számolólap
Szűrő neve: Hét száma (ezt a nevet megváltoztattam az adatfájlban szereplő "Feladási hét száma" névről)
Módosítandó cella: O26 és O27 (ennek a tartományba kell kerülnie)

Ebben a pivotban megpróbálom megváltoztatni az oszlopok szűrőjét, a PivotTable Fields menü szűrő területén nincs semmi.

az én kódom:

Private Sub Worksheet_Change (ByVal Target mint Range)
'Frissítés Extendoffice 20180702
Dim xPTable PivotTable-ként
Dim xPFile PivotFieldként
Dim xStr As String
On Error Resume Next
Ha a metszéspont(cél, tartomány("O26")) semmi, akkor lépjen ki az alból
Application.ScreenUpdating = Hamis
Set xPTable = Munkalapok("Számítási lap").PivotTables("Rendelés_Comp_B2C")
Állítsa be az xPFile = xPTable.PivotFields("hétszám")
xStr = Target.Text
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr
Application.ScreenUpdating = Igaz
End Sub

Köszönöm,

Justin
A weboldal moderátora ezt a megjegyzést minimalizálta
Szia Justin Teeuw!
megváltoztattam a Pivot név, lap neve, szűrő neve és a cellában változtatni a fent említett feltételekre, és kipróbáltam az általad megadott VBA kódot, esetemben jól működik. Lásd a következő GIF-et vagy a mellékelt munkafüzetet.
Nem bánja, ha létrehoz egy új munkafüzetet, és megpróbálja újra a kódot?
https://www.extendoffice.com/images/stories/comments/comment-picture-zxm/6.gif
A weboldal moderátora ezt a megjegyzést minimalizálta
Szia Crystal,

Csatoltam egy képernyőképet a pivotról, a piros doboz az a szűrő, amit a cellaérték alapján módosítani szeretnék.

Lehetőleg több hét számát jelölő cellatartományt szeretnék használni.

Köszönöm,

Justin
A weboldal moderátora ezt a megjegyzést minimalizálta
Szia Justin,
Sajnálom, hogy nem láttam a mellékelt képernyőképet az oldalon. Lehet, hogy valami hiba van az oldalon.
Ha továbbra is meg kell oldania a problémát, írjon nekem a zxm@addin99.com címre. Elnézést a kellemetlenségért.
A weboldal moderátora ezt a megjegyzést minimalizálta
Szia Justin Teeuw!
Kérjük, próbálja ki a következő VBA kódot. Remélem tudok segíteni.

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
A weboldal moderátora ezt a megjegyzést minimalizálta
Normál excellhez használtam és működött. De nem tudtam olap munkalapokhoz használni. lehet, hogy változtatnom kell rajta egy kicsit?
A weboldal moderátora ezt a megjegyzést minimalizálta
Szia maziaritib4 TIB!
A módszer csak Microsoft Excel esetén érhető el. Elnézést a kellemetlenségért.
A weboldal moderátora ezt a megjegyzést minimalizálta
Szia Justin,

Ez tökéletesen működött, de arra lennék kíváncsi, hogy ez a szabály alkalmazható-e több kimutatástáblára ugyanazon a munkalapon belül?

Köszönöm,
James
A weboldal moderátora ezt a megjegyzést minimalizálta
Szia James,

Igen, ez lehetséges, az általam használt kód (4 pivot és 2 cellahivatkozás):

Private Sub Worksheet_Change (ByVal Target mint Range)
Dim I As Integer
Az xFilterStr1, xFilterStr2, yFilterstr1, yfilterstr2 halványítása karakterláncként
On Error Resume Next
Ha a metszéspont(cél, tartomány("O26:P27")) semmi, akkor lépjen ki az alból

xFilterStr1 = Tartomány("O26").Érték
xFilterStr2 = Tartomány("O27").Érték
yFilterstr1 = Tartomány("p26").Érték
yfilterstr2 = Tartomány("p27").Érték
ActiveSheet.PivotTables("Order_Comp_B2C_Crea").PivotFields("Hét száma"). _
ActiveSheet.PivotTables("Order_Comp_B2B_Crea").PivotFields("Hét száma"). _
ActiveSheet.PivotTables("Order_Comp_B2C_Disp").PivotFields("Hét száma"). _
ActiveSheet.PivotTables("Order_Comp_B2B_Disp").PivotFields("Hét száma"). _
ClearAllFilters

Ha xFilterStr1 = "" És xFilterStr2 = "" És yFilterstr1 = "" És yfilterstr2 = "" Akkor lépjen ki az alból
ActiveSheet.PivotTables("Order_Comp_B2C_Crea").PivotFields("Hét száma"). _
ActiveSheet.PivotTables("Order_Comp_B2B_Crea").PivotFields("Hét száma"). _
ActiveSheet.PivotTables("Order_Comp_B2C_Disp").PivotFields("Hét száma"). _
ActiveSheet.PivotTables("Order_Comp_B2B_Disp").PivotFields("Hét száma"). _
EnableMultiplePageItems = Igaz

xCount = ActiveSheet.PivotTables("Order_Comp_B2C_Crea").PivotFields("Hét száma").PivotItems.Count
xCount = ActiveSheet.PivotTables("Order_Comp_B2B_Crea").PivotFields("Hét száma").PivotItems.Count
yCount = ActiveSheet.PivotTables("Order_Comp_B2C_Disp").PivotFields("Hét száma").PivotItems.Count
yCount = ActiveSheet.PivotTables("Order_Comp_B2B_Disp").PivotFields("Hét száma").PivotItems.Count

Ha I = 1 - xCount
Ha én <> xFilterStr1 És én <> xFilterStr2 Akkor
ActiveSheet.PivotTables("Order_Comp_B2C_Crea").PivotFields("Hét száma").PivotItems(I).Visible = False
ActiveSheet.PivotTables("Order_Comp_B2B_Crea").PivotFields("Hét száma").PivotItems(I).Visible = False
Más
ActiveSheet.PivotTables("Order_Comp_B2C_Crea").PivotFields("Hét száma").PivotItems(I).Visible = igaz
ActiveSheet.PivotTables("Order_Comp_B2B_Crea").PivotFields("Hét száma").PivotItems(I).Visible = igaz
Ha véget
Következő

Ha I = 1 To yCount
Ha én <> yFilterstr1 És én <> yfilterstr2 Akkor
ActiveSheet.PivotTables("Order_Comp_B2C_Disp").PivotFields("Hét száma").PivotItems(I).Visible = False
ActiveSheet.PivotTables("Order_Comp_B2B_Disp").PivotFields("Hét száma").PivotItems(I).Visible = False
Más
ActiveSheet.PivotTables("Order_Comp_B2C_Disp").PivotFields("Hét száma").PivotItems(I).Visible = igaz
ActiveSheet.PivotTables("Order_Comp_B2B_Disp").PivotFields("Hét száma").PivotItems(I).Visible = igaz
Ha véget
Következő

End Sub
A weboldal moderátora ezt a megjegyzést minimalizálta
Az Array(), a Worksheets() és a Intersect() értékeinek módosítása



**Keresse meg ezeket, és változtassa meg**
Lapnév
E1
PivotTable1
PivotTable2
PivotTable3




Private Sub Worksheet_Change (ByVal Target mint Range)
'Frissítés Extendoffice 20180702
Dim xPTable PivotTable-ként
Dim xPFile PivotFieldként

Dim xPTabled PivotTable-ként
Dim xPFiled As PivotField

Dim xStr As String



On Error Resume Next

'리스트 만들기
Dim listArray() As Variant
listArray = Tömb("PivotTable1", "PivotTable2", "PivotTable3")



Ha a metszéspont(cél, tartomány("E1")) semmi, akkor lépjen ki a Sub
Application.ScreenUpdating = Hamis

Ha i = 0 - UBound(listArray)

Set xPTable = Worksheets("SheetName").PivotTables(listArray(i))
Állítsa be az xPFile = xPTable.PivotFields("Cégazonosító")

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



Következő

Application.ScreenUpdating = Igaz



End Sub
A weboldal moderátora ezt a megjegyzést minimalizálta
Helló,

A kód nekem jól működik. Azonban nem tudom elérni, hogy a pivot tábla automatikusan frissítse a szűrőcélt. A cél az én esetemben egy képlet [DATE(D18,S14,C18)]. A kód csak akkor működik, ha duplán kattintok a célcellára, és megnyomom az Enter billentyűt.

Köszönöm
A weboldal moderátora ezt a megjegyzést minimalizálta
Helló,

Ez a kód tökéletesen működik. Azonban nem tudom megszerezni a kódot a pivot tábla automatikus frissítéséhez. Számomra a célérték egy képlet (=DATE(D18,...,..)), amely attól függően változik, hogy a D18-nál mi van kiválasztva. A pivot tábla frissítéséhez duplán kell kattintanom a célcellára, és meg kell nyomnom az Enter billentyűt. Van rá mód?

Köszönöm
A weboldal moderátora ezt a megjegyzést minimalizálta
Szia ST!
Tegyük fel, hogy a célérték H6-ban van, és a D18 értékétől függően változik. Kimutatástábla szűrése e célérték alapján. A következő VBA kód segíthet. Kérjük, próbálja ki.
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
A weboldal moderátora ezt a megjegyzést minimalizálta
Szia Crysal!

Hozzáadtam egy sort a kódhoz: Dim xRg As Range

A kód nem állítja vissza automatikusan a dátumokat a cél megváltoztatásakor. Van egy excel fájlom, amely reprodukálja azt, amit megpróbálok csinálni, de nem tudok mellékleteket hozzáadni ezen a webhelyen. A D3 (cél = DÁTUM(A15,B15,C15)) egyenlete az A15-höz, B15-höz és C15-höz kapcsolódik. Ha az A15, B15 és C15 bármely értéke megváltozik, a pivot tábla visszaáll szűrő nélkül. Tudnátok nekem ebben segíteni?
A weboldal moderátora ezt a megjegyzést minimalizálta
Szia ST!
Nem egészen értem mire gondolsz. Az Ön esetében a D3 célcella értéke a kimutatástábla szűrésére szolgál. A D3 célcellában lévő képlet az A15, B15 és C15 cellák értékeire hivatkozik, amelyek a referenciacellák értékeinek megfelelően változnak. Ha az A15, B15 és C15 bármely értéke megváltozik, a kimutatástábla automatikusan szűrésre kerül, ha a célcellában lévő érték megfelel a kimutatástábla szűrési feltételeinek. Ha a célcellában lévő érték nem felel meg a kimutatástábla szűrési feltételeinek, a kimutatástábla automatikusan visszaáll szűrés nélkülire.
A weboldal moderátora ezt a megjegyzést minimalizálta
Nem vagyok benne biztos, hogy van-e mód Excel fájl megosztására Önnel. Ha a célértékem, amely egy dátum, a többi cellában bekövetkezett változásnak megfelelően változik. Duplán kell kattintanom a célcellára, és le kell nyomnom az Enter billentyűt (ahogyan a képlet cellába való beírása után tenné) a pivot tábla frissítéséhez.
A weboldal moderátora ezt a megjegyzést minimalizálta
Szia Sagar T!
A kód frissítve lett. Kérjük, próbálja ki. Köszönjük a visszajelzést.
Ne felejtse el megváltoztatni a munkalap, a pivot tábla és a szűrő nevét a kódban. Vagy letöltheti tesztelésre a következő feltöltött munkafüzetet.

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
A weboldal moderátora ezt a megjegyzést minimalizálta
keresse meg ezeket és változtassa meg az Array(), Intersect(), Worksheets(), PivotFields()

PivotTable1
PivotTable2
PivotTable3
PivotTable4
H1
Lapnév
Mező neve




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
A weboldal moderátora ezt a megjegyzést minimalizálta
Как сделать чтобы сводная таблица применяла сразу 2 фильтра из 2хразных ячеек? а не 1 как в примере?
A weboldal moderátora ezt a megjegyzést minimalizálta
Szia Алексей!

Kérjük, ellenőrizze, hogy van-e VBA kód ebben a megjegyzésben #38754 segíthet.
A weboldal moderátora ezt a megjegyzést minimalizálta
Можно ли сослаться вместо ячейки H6 на ячейку на другом листе? как это сделать? подскажите пожалуйста.
A weboldal moderátora ezt a megjegyzést minimalizálta
Szia Алексей!

Nem kell módosítania a kódot, csak adja hozzá a VBA kódot a hivatkozni kívánt cella munkalapjához.
Ha például egy "" nevű pivot táblát szeretne szűrniPivotTable1" ban ben Sheet2 cella értéke alapján H6 in Sheet3, kattintson jobb gombbal a Sheet3 munkalap lapon kattintson Kód megtekintése a jobb gombbal kattintson a menüből, majd adja hozzá a kódot a 3. munkalap (kód) ablak.
Még senki sem írt megjegyzést
Hagyja meg észrevételeit
Feladás vendégként
×
Értékeld ezt a bejegyzést:
0   Karakterek
Javasolt helyek

Kövess minket

Copyright © 2009 - www.extendoffice.com. | Minden jog fenntartva. Powered by ExtendOffice. | Oldaltérkép
A Microsoft és az Office logó a Microsoft Corporation védjegyei vagy bejegyzett védjegyei az Egyesült Államokban és / vagy más országokban.
Sectigo SSL védi