Ir para o conteúdo principal

Como vincular o filtro Pivot Table a uma determinada célula no Excel?

Se você deseja vincular um filtro de Tabela Dinâmica a uma determinada célula e filtrar a Tabela Dinâmica com base no valor da célula, o método neste artigo pode ajudá-lo.

Vincular o filtro da tabela dinâmica a uma determinada célula com o código VBA


Vincular o filtro da tabela dinâmica a uma determinada célula com o código VBA

A Tabela Dinâmica que você vinculará sua função de filtro a um valor de célula deve incluir um campo de filtro (o nome do campo de filtro tem uma função importante no código VBA a seguir).

Veja a Tabela Dinâmica abaixo como exemplo. O campo de filtro na Tabela Dinâmica é chamado Categoria, e inclui dois valores “Despesas"E"Vendas”. Depois de vincular o filtro Tabela Dinâmica a uma célula, os valores da célula que você aplicará ao filtro Tabela Dinâmica devem ser “Despesas” e “Vendas”.

1. Selecione a célula (aqui eu seleciono a célula H6) que você vinculará à função de filtro da Tabela Dinâmica e insira um dos valores do filtro na célula com antecedência.

2. Abra a planilha que contém a Tabela Dinâmica que você vinculará à célula. Clique com o botão direito na guia da planilha e selecione Ver código no menu de contexto. Veja a imagem:

3. No Microsoft Visual Basic para Aplicações janela, copie o código do VBA abaixo para a janela de código.

Código VBA: vincular o filtro da tabela dinâmica a uma determinada célula

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

Notas:

1) "Sheet1Ӄ o nome da planilha aberta.
2) "Tabela Dinâmica 2”É o nome da Tabela Dinâmica; você vinculará sua função de filtro a uma célula.
3) O campo de filtragem na tabela dinâmica é denominado "Categoria".
4) A célula referenciada é H6. Você pode alterar esses valores de variáveis ​​com base em suas necessidades.

4. aperte o outro + Q chaves para fechar o Microsoft Visual Basic para Aplicações janela.

Agora, a função de filtro da Tabela Dinâmica está vinculada à célula H6.

Atualize a célula H6 e os dados correspondentes na Tabela Dinâmica serão filtrados com base no valor existente. Veja a imagem:

Ao alterar o valor da célula, os dados filtrados na Tabela Dinâmica serão alterados automaticamente. Veja a imagem:


Selecione facilmente linhas inteiras com base no valor da célula em uma coluna certian:

A Selecione células específicas utilidade de Kutools for Excel pode ajudá-lo a selecionar rapidamente linhas inteiras com base no valor da célula em uma coluna certian no Excel, conforme a imagem mostrada abaixo. Depois de selecionar todas as linhas com base no valor da célula, você pode movê-las manualmente ou copiá-las para um novo local conforme necessário no Excel.
Baixe e experimente agora! (trilha gratuita de 30 dias)


Artigos relacionados:

Melhores ferramentas de produtividade de escritório

Recursos mais comuns: Encontre, destaque ou identifique duplicatas   |  Excluir linhas em branco   |  Combine colunas ou células sem perder dados   |   Rodada sem Fórmula ...
Super pesquisa: VLookup de múltiplos critérios    VLookup de múltiplos valores  |   VLookup em várias planilhas   |   Pesquisa Difusa ....
Lista suspensa avançada: Crie rapidamente uma lista suspensa   |  Lista suspensa de dependentes   |  Lista suspensa de seleção múltipla ....
Gerenciador de colunas: Adicione um número específico de colunas  |  Mover colunas  |  Alternar status de visibilidade de colunas ocultas  |  Compare intervalos e colunas ...
Recursos em destaque: Foco da Grade   |  Vista de Design   |   Grande Barra de Fórmula    Gerenciador de pastas de trabalho e planilhas   |  Biblioteca (Auto texto)   |  Data Picker   |  Combinar planilhas   |  Criptografar/Descriptografar Células    Enviar e-mails por lista   |  Super Filtro   |   Filtro Especial (filtro negrito/itálico/tachado...) ...
15 principais conjuntos de ferramentas12 Texto Ferramentas (Adicionar texto, Remover Personagens, ...)   |   50+ de cores Tipos (Gráfico de Gantt, ...)   |   Mais de 40 práticos Fórmulas (Calcule a idade com base no aniversário, ...)   |   19 Inclusão Ferramentas (Insira o código QR, Inserir imagem do caminho, ...)   |   12 Conversão Ferramentas (Números para Palavras, Conversão de moedas, ...)   |   7 Unir e dividir Ferramentas (Combinar linhas avançadas, Dividir células, ...)   |   ... e mais

Aprimore suas habilidades de Excel com o Kutools para Excel e experimente uma eficiência como nunca antes. Kutools para Excel oferece mais de 300 recursos avançados para aumentar a produtividade e economizar tempo.  Clique aqui para obter o recurso que você mais precisa...

guia kte 201905


Office Tab traz interface com guias para o Office e torna seu trabalho muito mais fácil

  • Habilite a edição e leitura com guias em Word, Excel, PowerPoint, Publisher, Access, Visio e Project.
  • Abra e crie vários documentos em novas guias da mesma janela, em vez de em novas janelas.
  • Aumenta sua produtividade em 50% e reduz centenas de cliques do mouse para você todos os dias!
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