Ugrás a tartalomra

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:

Az 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 hatékonyságnövelő eszközök

Népszerű szolgáltatások: Ismétlődések keresése, kiemelése vagy azonosítása   |  Üres sorok törlése   |  Oszlopok vagy cellák kombinálása adatvesztés nélkül   |   Kerek Formula nélkül ...
Szuper keresés: Több kritérium VLookup    Többértékű VLookup  |   VLookup több munkalapon   |   Fuzzy Lookup ....
Speciális legördülő lista: Gyors legördülő lista létrehozása   |  Függő legördülő lista   |  Többszörösen válassza ki a legördülő listát ....
Oszlopkezelő: Adjon meg egy adott számú oszlopot  |  Oszlopok mozgatása  |  Kapcsolja be a Rejtett oszlopok láthatósági állapotát  |  Tartományok és oszlopok összehasonlítása ...
Kiemelt funkciók: Rács fókusz   |  Design nézet   |   Nagy Formula bár    Munkafüzet és lapkezelő   |  Erőforrás-könyvtár (Auto szöveg)   |  Dátumválasztó   |  Kombinálja a munkalapokat   |  Cellák titkosítása/dekódolása    E-mailek küldése listánként   |  Szuper szűrő   |   Speciális szűrő (félkövér/dőlt/áthúzott szűrés...) ...
A 15 legjobb eszközkészlet12 szöveg Eszközök (Szöveg hozzáadása, Karakterek eltávolítása,...)   |   50 + Táblázatos Típusai (Gantt-diagram,...)   |   40+ Praktikus képletek (Számolja ki az életkort a születésnap alapján,...)   |   19 beszúrás Eszközök (Helyezze be a QR-kódot, Kép beszúrása az útvonalból,...)   |   12 Átalakítás Eszközök (Számok szavakig, Valuta átváltás,...)   |   7 Egyesítés és felosztás Eszközök (Haladó kombinált sorok, Hasított sejtek,...)   |   ... és több

Töltsd fel Excel-készségeidet a Kutools for Excel segítségével, és tapasztald meg a még soha nem látott hatékonyságot. A Kutools for Excel több mint 300 speciális funkciót kínál a termelékenység fokozásához és az időmegtakarításhoz.  Kattintson ide, hogy megszerezze a leginkább szükséges funkciót...

kte lap 201905


Az Office lap füles felületet hoz 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!
Comments (38)
No ratings yet. Be the first to rate!
This comment was minimized by the moderator on the site
Hi,
This code worked perfectly on the pivot table, but I also want to link a filter to a cell value on a Table. Is there code for this? Please help :)
This comment was minimized by the moderator on the site
if my column in pivot table is date this code not working, can some one help me please
This comment was minimized by the moderator on the site
Можно ли сослаться вместо ячейки H6 на ячейку на другом листе? как это сделать? подскажите пожалуйста.
This comment was minimized by the moderator on the site
Hi Алексей,

You don't need to modify the code, just add the VBA code to the worksheet of the cell you want to reference.
For example, if you want to filter a pivot table named "PivotTable1" in Sheet2 based on the value of cell H6 in Sheet3, please right click the Sheet3 worksheet tab, click View Code from the right-clicking menu, and then add the code to the Sheet3 (Code) window.
This comment was minimized by the moderator on the site
Как сделать чтобы сводная таблица применяла сразу 2 фильтра из 2хразных ячеек? а не 1 как в примере?
This comment was minimized by the moderator on the site
Hi Алексей,

Please check if the VBA code in this comment #38754 can help.
This comment was minimized by the moderator on the site
find these and change it in Array(),Intersect(), Worksheets(), PivotFields()

PivotTable1
PivotTable2
PivotTable3
PivotTable4
H1
SheetName
FieldName




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
This comment was minimized by the moderator on the site
Hello,

This code works perfectly. However I am not able to get the code to update the pivot table automatically. The target value for me is a formula (=DATE(D18,..,..)) which changes depending on what is selected at D18. For it to update the pivot table i have to double click the target cell and hit enter. Is there a way around it?

Thank you
This comment was minimized by the moderator on the site
Hello ST,
Suppose your target value is in H6 and it changes depending on the value in D18. To filter a pivot table based on this target value. The following VBA code can help. Please give it a try.
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
This comment was minimized by the moderator on the site
Hello Crysal,

I added a line on the code : Dim xRg As Range

The code doesn't automatically reset the dates when the target is changed. I have an excel file replicating what I am trying to do, I a not able to add attachments on this website though. D3 (target = DATE(A15,B15,C15)) has an equation linked to A15, B15 and C15. When any value on A15, B15 and C15 is changed the pivot table resets to no filter. Could you help me out on this?
This comment was minimized by the moderator on the site
Hi ST,
I don't quite understand what you mean. In your case, the value of target cell D3 is used to filter the pivot table. The formula in the target cell D3 references the values of cells A15, B15 and C15, which will change according to the values in the reference cells. When any value on A15, B15 and C15 is changed, the pivot table will be automatically filtered if the value in the target cell meets the filter conditions of the pivot table. If the value in the target cell does not meet the pivot table's filtering criteria, the pivot table will be automatically reset to no filtering.
This comment was minimized by the moderator on the site
I’m not sure if there is a way to share an excel file with you. If my target value, which is a date, changes according to changes in other cells. I have to double click on the target cell and hit enter (like you would after entering a formula in a cell) to update the pivot table
This comment was minimized by the moderator on the site
Hi Sagar T,
The code has been updated. Please give it a try. Thanks for your feedback.
Don't forget to change the names of the worksheet, pivot table and the filter in the code. Or you can download the following uploaded workbook for testing.

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
This comment was minimized by the moderator on the site
Hello,

The code works fine for me. However I am not able to get the pivot table to update the filter target automatically. The target in my case is a formula [DATE(D18,S14,C18)]. The code only works when I double click the target cell and hit enter.

Thank you
This comment was minimized by the moderator on the site
Hi Justin,

This has worked perfectly, however, I am wondering if this rule can be applied to multiple PivotTables within the same sheet?

Thanks,
James
This comment was minimized by the moderator on the site
Change Values in Array(), Worksheets() and Intersect()



**Find these and change it**
SheetName
E1
PivotTable1
PivotTable2
PivotTable3




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



If Intersect(Target, Range("E1")) 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("Company_ID")

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



Next

Application.ScreenUpdating = True



End Sub
This comment was minimized by the moderator on the site
Hi James,

Yes this is possible, code I used for this is (4 pivots and 2 cell references):

Private Sub Worksheet_Change(ByVal Target As Range)
Dim I As Integer
Dim xFilterStr1, xFilterStr2, yFilterstr1, yfilterstr2 As String
On Error Resume Next
If Intersect(Target, Range("O26:P27")) Is Nothing Then Exit Sub

xFilterStr1 = Range("O26").Value
xFilterStr2 = Range("O27").Value
yFilterstr1 = Range("p26").Value
yfilterstr2 = Range("p27").Value
ActiveSheet.PivotTables("Order_Comp_B2C_Crea").PivotFields("Week Number"). _
ActiveSheet.PivotTables("Order_Comp_B2B_Crea").PivotFields("Week Number"). _
ActiveSheet.PivotTables("Order_Comp_B2C_Disp").PivotFields("Week Number"). _
ActiveSheet.PivotTables("Order_Comp_B2B_Disp").PivotFields("Week Number"). _
ClearAllFilters

If xFilterStr1 = "" And xFilterStr2 = "" And yFilterstr1 = "" And yfilterstr2 = "" Then Exit Sub
ActiveSheet.PivotTables("Order_Comp_B2C_Crea").PivotFields("Week Number"). _
ActiveSheet.PivotTables("Order_Comp_B2B_Crea").PivotFields("Week Number"). _
ActiveSheet.PivotTables("Order_Comp_B2C_Disp").PivotFields("Week Number"). _
ActiveSheet.PivotTables("Order_Comp_B2B_Disp").PivotFields("Week Number"). _
EnableMultiplePageItems = True

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

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

For I = 1 To yCount
If I <> yFilterstr1 And I <> yfilterstr2 Then
ActiveSheet.PivotTables("Order_Comp_B2C_Disp").PivotFields("Week Number").PivotItems(I).Visible = False
ActiveSheet.PivotTables("Order_Comp_B2B_Disp").PivotFields("Week Number").PivotItems(I).Visible = False
Else
ActiveSheet.PivotTables("Order_Comp_B2C_Disp").PivotFields("Week Number").PivotItems(I).Visible = True
ActiveSheet.PivotTables("Order_Comp_B2B_Disp").PivotFields("Week Number").PivotItems(I).Visible = True
End If
Next

End Sub
This comment was minimized by the moderator on the site
I used it for a normal excell and it worked.But I could not use it for an olap worksheets. maybe I need to change it a little?
This comment was minimized by the moderator on the site
Hi maziaritib4 TIB,
The method is only avaliable for Microsoft Excel. Sorry for the inconvenience.
This comment was minimized by the moderator on the site
Hi,

Tried to get this working for the column filter but does not seem to work. Do I need an other code for that?

Thanks
This comment was minimized by the moderator on the site
Hi Justin,
Did you get any error prompt? I need to know more specific about your issue.
Before applying the code, don't forget to modify the "name of the sheet", "name of the pivot table", "name of the filter of pivot table" and the cell you want to filter the pivot table based on (see sceenshot).
https://www.extendoffice.com/images/stories/comments/comment-picture-zxm/4.png
This comment was minimized by the moderator on the site
Hi Crystal,

Thanks for your help. Issue is the function is not doing anything for some reason. Some clarification:

Pivot name: Order_Comp_B2C
Sheet Name: Calculation Sheet
Filter name: Week Number (I changed this name from what was "Dispatch Week No" in the data file)
Cell to change: O26 and O27 (this should go in range)

In this pivot, I am trying to get the filter changed for the columns, I have nothing in the filter area in the PivotTable Fields menu.

my code is:

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("O26")) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Set xPTable = Worksheets("Calculation Sheet").PivotTables("Order_Comp_B2C")
Set xPFile = xPTable.PivotFields("Week Number")
xStr = Target.Text
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr
Application.ScreenUpdating = True
End Sub

Thanks,

Justin
This comment was minimized by the moderator on the site
Hi Justin Teeuw,
I have changed the Pivot name, sheet name, filter name and cell to change to the conditions you mentioned above, and tried the VBA code you provided, it works well in my case. See the following GIF or the attached workbook.
Do you mind creating a new workbook and try the code again?
https://www.extendoffice.com/images/stories/comments/comment-picture-zxm/6.gif
This comment was minimized by the moderator on the site
Hi Crystal,

Attached a screenshot of the pivot, the red box is the filter I would like to change based on the cell value.

Preferably I would like to use a range of cells indicating multiple week numbers.

Thanks,

Justin
This comment was minimized by the moderator on the site
Hi Justin Teeuw,
Please try the following VBA code. Hope I can help.

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
This comment was minimized by the moderator on the site
Hi Justin,
Sorry I didn't see the screenshot you attached on the page. Maybe there is some error on the page.
If you still need to solve the problem, email me via . Sorry for the inconvenience.
There are no comments posted here yet
Load More
Please leave your comments in English
Posting as Guest
×
Rate this post:
0   Characters
Suggested Locations