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

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:

O 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! (30-dia de trilha livre)


Artigos relacionados:


As melhores ferramentas de produtividade para escritório

O Kutools for Excel resolve a maioria dos seus problemas e aumenta sua produtividade em 80%

  • armadilha para peixes: Insira rapidamente fórmulas complexas, gráficos e qualquer coisa que você tenha usado antes; Criptografar células com senha; Criar lista de discussão e enviar emails ...
  • Barra Super Fórmula (edite facilmente várias linhas de texto e fórmula); Layout de leitura (ler e editar facilmente um grande número de células); Colar na faixa filtrada...
  • Mesclar células / linhas / colunas sem perder dados; Dividir o conteúdo das células; Combinar linhas / colunas duplicadas... Evite células duplicadas; Comparar intervalos...
  • Selecione Duplicado ou Único Linhas; Selecione linhas em branco (todas as células estão vazias); Super Find e Fuzzy Find em muitos livros; Seleção aleatória ...
  • Cópia exata Várias células sem alterar a referência da fórmula; Criação automática de referências para várias folhas; Inserir marcadores, Caixas de seleção e mais ...
  • Extrair Texto, Adicionar texto, remover por posição, Remover Espaço; Criar e imprimir subtotais de paginação; Converter entre conteúdo de células e comentários...
  • Super Filtro (salvar e aplicar esquemas de filtro a outras planilhas); Classificação Avançada por mês / semana / dia, frequência e mais; Filtro Especial por negrito, itálico ...
  • Combine pastas de trabalho e planilhas; Mesclar tabelas com base em colunas-chave; Divida os dados em várias folhas; Conversão em lote de xls, xlsx e PDF...
  • Mais de 300 recursos poderosos. Suporta Office / Excel 2007-2021 e 365. Suporta todos os idiomas. Fácil implantação em sua empresa ou organização. Recursos completos de avaliação gratuita de 30 dias. Garantia de devolução do dinheiro em 60 dias.
guia kte 201905

Guia do Office 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!
parte inferior da aba do escritório
Comentários (36)
Ainda não há classificações. Seja o primeiro a avaliar!
Este comentário foi feito pelo moderador no site
como fazer isso em vários campos, pois no código há apenas um destino
Este comentário foi feito pelo moderador no site
oi Frank
Sory não pode ajudá-lo com isso.
Este comentário foi feito pelo moderador no site
E se a célula que está vinculada à Tabela Dinâmica, neste caso H6, estiver em outra planilha? Como muda o código?
Este comentário foi feito pelo moderador no site
e se eu tiver mais de 1 tabela dinâmica e vincular a 1 célula. Como devo alterar o código?
Este comentário foi feito pelo moderador no site
Olá Jeri,
Desculpe não poder ajudá-lo com isso. Bem-vindo a postar qualquer pergunta em nosso fórum: https://www.extendoffice.com/forum.html para obter mais suporte do Excel de profissionais do Excel ou de outros fãs do Excel.
Este comentário foi feito pelo moderador no site
encontre-os e altere-os em Array(),Intersect(), Worksheets(), PivotFields()

Tabela Dinâmica 1
Tabela Dinâmica 2
Tabela Dinâmica 3
Tabela Dinâmica 4
H1
Nome da Planilha
Nome do campo




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
Este comentário foi feito pelo moderador no site
Boa tarde...! Ótimo, como faço para usar o filtro em duas ou mais tabelas dinâmicas...? Obrigado desde já.

Boa tarde...! Ótima publicação, como uso o filtro em duas ou mais Tabelas Dinâmicas...? Desde já, obrigado.
Este comentário foi feito pelo moderador no site
Olá Gilmar Alves,
Desculpe não poder ajudá-lo com isso. Bem-vindo a postar qualquer pergunta em nosso fórum: https://www.extendoffice.com/forum.html para obter mais suporte do Excel de profissionais do Excel ou de outros fãs do Excel.
Este comentário foi feito pelo moderador no site
Alguém descobriu a questão de vinculação de várias tabelas dinâmicas?
Este comentário foi feito pelo moderador no site
Alterar valores em Array(), Worksheets() e Intersect()



**Encontre-os e altere-os**
Nome da Planilha
E1
Tabela Dinâmica 1
Tabela Dinâmica 2
Tabela Dinâmica 3




Private Sub Worksheet_Change (ByVal Target As Range)
'Atualizar por Extendoffice 20180702
Dim xPTable como tabela dinâmica
Dim xPFile como PivotField

Dim xPTabled como tabela dinâmica
Dim xPFiled como PivotField

Dim xStr As String



On Error Resume Next

'리스트 만들기
Dim listArray() como variante
listArray = Array("Tabela Dinâmica1", "Tabela Dinâmica2", "Tabela Dinâmica3")



Se Intersect(Target, Range("E1")) não for nada, então Exit Sub
Application.ScreenUpdating = False

Para i = 0 Para UBound(listArray)

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

xStr = Alvo.Texto
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr



Seguinte

Application.ScreenUpdating = True



End Sub
Este comentário foi feito pelo moderador no site
Ciao, sto provando a tarifa lo stesso esempio per far in modo che il Filter della pivot si setti sul valore della cella,
não riesco a farla funzionare.

Quale passaggio manca nella descrizione sopra?
Este comentário foi feito pelo moderador no site
Oi,
Você recebeu algum prompt de erro? Preciso saber mais especificamente sobre seu problema, como sua versão do Excel. E se você não se importar, tente criar seus dados em uma nova pasta de trabalho e tente novamente, ou faça uma captura de tela de seus dados e carregue-a aqui.
Este comentário foi feito pelo moderador no site
Oi,

Tentei fazer isso funcionar para o filtro de coluna, mas não parece funcionar. Preciso de outro código para isso?

obrigado
Este comentário foi feito pelo moderador no site
Oi Justin,
Você recebeu algum prompt de erro? Preciso saber mais especificamente sobre seu problema.
Antes de aplicar o código, não esqueça de modificar o "nome da folha""nome da tabela dinâmica""nome do filtro da tabela dinâmica" e as célula você deseja filtrar a tabela dinâmica com base (veja a captura de tela).
https://www.extendoffice.com/images/stories/comments/comment-picture-zxm/4.png
Este comentário foi feito pelo moderador no site
Olá Cristal,

Obrigado pela ajuda. O problema é que a função não está fazendo nada por algum motivo. Alguns esclarecimentos:

Nome do pivô: Order_Comp_B2C
Nome da Planilha: Planilha de Cálculo
Nome do filtro: Número da semana (alterei este nome do que era "Dispatch Week No" no arquivo de dados)
Célula a ser alterada: O26 e O27 (isso deve estar dentro do intervalo)

Neste pivô, estou tentando alterar o filtro das colunas, não tenho nada na área de filtro no menu Campos da Tabela Dinâmica.

meu código é:

Private Sub Worksheet_Change (ByVal Target As Range)
'Atualizar por Extendoffice 20180702
Dim xPTable como tabela dinâmica
Dim xPFile como PivotField
Dim xStr As String
On Error Resume Next
If Intersect(Target, Range("O26")) não é nada, então Exit Sub
Application.ScreenUpdating = False
Set xPTable = Worksheets("Folha de cálculo").PivotTables("Order_Comp_B2C")
Definir xPFile = xPTable.PivotFields("Número da Semana")
xStr = Alvo.Texto
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr
Application.ScreenUpdating = True
End Sub

Obrigado,

Justin
Este comentário foi feito pelo moderador no site
Olá Justin Teeu,
Eu mudei o Nome do pivô, nome da folha, nome do filtro e célula para mudar para as condições que você mencionou acima e tentei o código VBA que você forneceu, funciona bem no meu caso. Consulte o GIF a seguir ou a pasta de trabalho anexada.
Você se importa de criar uma nova pasta de trabalho e tentar o código novamente?
https://www.extendoffice.com/images/stories/comments/comment-picture-zxm/6.gif
Este comentário foi feito pelo moderador no site
Olá Cristal,

Em anexo uma captura de tela do pivô, a caixa vermelha é o filtro que gostaria de alterar com base no valor da célula.

De preferência, gostaria de usar um intervalo de células indicando vários números de semanas.

Obrigado,

Justin
Este comentário foi feito pelo moderador no site
Oi Justin,
Desculpe, não vi a captura de tela que você anexou na página. Talvez haja algum erro na página.
Se você ainda precisar resolver o problema, envie um e-mail para zxm@addin99.com. Desculpe pela inconveniência.
Este comentário foi feito pelo moderador no site
Olá Justin Teeuw
Por favor, tente o seguinte código VBA. Espero que eu possa ajudar.

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
Este comentário foi feito pelo moderador no site
Usei para um excell normal e funcionou. Mas não consegui usar para planilhas olap. talvez eu precise mudar um pouco?
Este comentário foi feito pelo moderador no site
Olá maziaritib4 TIB,
O método está disponível apenas para Microsoft Excel. Desculpe pela inconveniência.
Este comentário foi feito pelo moderador no site
Oi Justin,

Isso funcionou perfeitamente, porém, gostaria de saber se essa regra pode ser aplicada a várias Tabelas Dinâmicas dentro da mesma planilha?

Obrigado,
James
Este comentário foi feito pelo moderador no site
Oi James,

Sim, isso é possível, o código que usei para isso é (4 pivôs e 2 referências de célula):

Private Sub Worksheet_Change (ByVal Target As Range)
Dim I como inteiro
Dim xFilterStr1, xFilterStr2, yFilterstr1, yfilterstr2 como string
On Error Resume Next
If Intersect(Target, Range("O26:P27")) não é nada, então 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("Número da Semana"). _
ActiveSheet.PivotTables("Order_Comp_B2B_Crea").PivotFields("Número da Semana"). _
ActiveSheet.PivotTables("Order_Comp_B2C_Disp").PivotFields("Número da semana"). _
ActiveSheet.PivotTables("Order_Comp_B2B_Disp").PivotFields("Número da semana"). _
Limpar todos os filtros

Se xFilterStr1 = "" E xFilterStr2 = "" E yFilterstr1 = "" E yfilterstr2 = "" Então Exit Sub
ActiveSheet.PivotTables("Order_Comp_B2C_Crea").PivotFields("Número da Semana"). _
ActiveSheet.PivotTables("Order_Comp_B2B_Crea").PivotFields("Número da Semana"). _
ActiveSheet.PivotTables("Order_Comp_B2C_Disp").PivotFields("Número da semana"). _
ActiveSheet.PivotTables("Order_Comp_B2B_Disp").PivotFields("Número da semana"). _
EnableMultiplePageItems = Verdadeiro

xCount = ActiveSheet.PivotTables("Order_Comp_B2C_Crea").PivotFields("Número da semana").PivotItems.Count
xCount = ActiveSheet.PivotTables("Order_Comp_B2B_Crea").PivotFields("Número da Semana").PivotItems.Count
yCount = ActiveSheet.PivotTables("Order_Comp_B2C_Disp").PivotFields("Número da semana").PivotItems.Count
yCount = ActiveSheet.PivotTables("Order_Comp_B2B_Disp").PivotFields("Número da semana").PivotItems.Count

Para I = 1 Para xCount
Se eu <> xFilterStr1 E <> xFilterStr2 Então
ActiveSheet.PivotTables("Order_Comp_B2C_Crea").PivotFields("Número da semana").PivotItems(I).Visible = False
ActiveSheet.PivotTables("Order_Comp_B2B_Crea").PivotFields("Número da semana").PivotItems(I).Visible = False
Outro
ActiveSheet.PivotTables("Order_Comp_B2C_Crea").PivotFields("Número da Semana").PivotItems(I).Visible = True
ActiveSheet.PivotTables("Order_Comp_B2B_Crea").PivotFields("Número da semana").PivotItems(I).Visible = True
Se acabar
Seguinte

Para I = 1 Para yCount
Se eu <> yFilterstr1 E eu <> yfilterstr2 Então
ActiveSheet.PivotTables("Order_Comp_B2C_Disp").PivotFields("Número da semana").PivotItems(I).Visible = False
ActiveSheet.PivotTables("Order_Comp_B2B_Disp").PivotFields("Número da semana").PivotItems(I).Visible = False
Outro
ActiveSheet.PivotTables("Order_Comp_B2C_Disp").PivotFields("Número da semana").PivotItems(I).Visible = True
ActiveSheet.PivotTables("Order_Comp_B2B_Disp").PivotFields("Número da semana").PivotItems(I).Visible = True
Se acabar
Seguinte

End Sub
Este comentário foi feito pelo moderador no site
Alterar valores em Array(), Worksheets() e Intersect()



**Encontre-os e altere-os**
Nome da Planilha
E1
Tabela Dinâmica 1
Tabela Dinâmica 2
Tabela Dinâmica 3




Private Sub Worksheet_Change (ByVal Target As Range)
'Atualizar por Extendoffice 20180702
Dim xPTable como tabela dinâmica
Dim xPFile como PivotField

Dim xPTabled como tabela dinâmica
Dim xPFiled como PivotField

Dim xStr As String



On Error Resume Next

'리스트 만들기
Dim listArray() como variante
listArray = Array("Tabela Dinâmica1", "Tabela Dinâmica2", "Tabela Dinâmica3")



Se Intersect(Target, Range("E1")) não for nada, então Exit Sub
Application.ScreenUpdating = False

Para i = 0 Para UBound(listArray)

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

xStr = Alvo.Texto
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr



Seguinte

Application.ScreenUpdating = True



End Sub
Este comentário foi feito pelo moderador no site
Olá,

O código funciona bem para mim. No entanto, não consigo fazer com que a tabela dinâmica atualize o destino do filtro automaticamente. O alvo no meu caso é uma fórmula [DATA(D18,S14,C18)]. O código só funciona quando eu clico duas vezes na célula de destino e pressiono enter.

Obrigado
Este comentário foi feito pelo moderador no site
Olá,

Este código funciona perfeitamente. No entanto, não consigo obter o código para atualizar a tabela dinâmica automaticamente. O valor de destino para mim é uma fórmula (=DATE(D18,..,..)) que muda dependendo do que é selecionado em D18. Para atualizar a tabela dinâmica, tenho que clicar duas vezes na célula de destino e pressionar enter. Existe uma maneira de contornar isso?

Obrigado
Este comentário foi feito pelo moderador no site
Olá ST,
Suponha que seu valor alvo esteja em H6 e mude dependendo do valor em D18. Para filtrar uma tabela dinâmica com base nesse valor de destino. O seguinte código VBA pode ajudar. Por favor, tente.
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
Este comentário foi feito pelo moderador no site
Olá Crisal,

Eu adicionei uma linha no código: Dim xRg As Range

O código não redefine automaticamente as datas quando o destino é alterado. Eu tenho um arquivo do Excel replicando o que estou tentando fazer, mas não consigo adicionar anexos neste site. D3 (alvo = DATA(A15,B15,C15)) tem uma equação ligada a A15, B15 e C15. Quando qualquer valor em A15, B15 e C15 é alterado, a tabela dinâmica é redefinida para nenhum filtro. Você poderia me ajudar nisso?
Este comentário foi feito pelo moderador no site
Olá ST,
Não entendo muito bem o que você quer dizer. No seu caso, o valor da célula de destino D3 é usado para filtrar a tabela dinâmica. A fórmula na célula de destino D3 faz referência aos valores das células A15, B15 e C15, que serão alteradas de acordo com os valores nas células de referência. Quando qualquer valor em A15, B15 e C15 for alterado, a tabela dinâmica será filtrada automaticamente se o valor na célula de destino atender às condições de filtro da tabela dinâmica. Se o valor na célula de destino não atender aos critérios de filtragem da tabela dinâmica, a tabela dinâmica será redefinida automaticamente para sem filtragem.
Este comentário foi feito pelo moderador no site
Não tenho certeza se existe uma maneira de compartilhar um arquivo do Excel com você. Se meu valor de destino, que é uma data, muda de acordo com as alterações em outras células. Eu tenho que clicar duas vezes na célula de destino e pressionar enter (como você faria depois de inserir uma fórmula em uma célula) para atualizar a tabela dinâmica
Este comentário foi feito pelo moderador no site
Olá Sagar T,
O código foi atualizado. Por favor, tente. Obrigado pelo seu feedback!
Não esqueça de alterar os nomes da planilha, da tabela dinâmica e do filtro no código. Ou você pode baixar a seguinte pasta de trabalho carregada para teste.

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
Este comentário foi feito pelo moderador no site
encontre-os e altere-os em Array(),Intersect(), Worksheets(), PivotFields()

Tabela Dinâmica 1
Tabela Dinâmica 2
Tabela Dinâmica 3
Tabela Dinâmica 4
H1
Nome da Planilha
Nome do campo




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
Este comentário foi feito pelo moderador no site
Как сделать чтобы сводная таблица применяла сразу 2 фильтра из 2хразных ячеек? а не 1 как в примере?
Este comentário foi feito pelo moderador no site
Olá Алексей,

Verifique se o código VBA neste comentário #38754 podem ajudar.
Este comentário foi feito pelo moderador no site
Можно ли сослаться вместо ячейки H6 на ячейку на другом листе? как это сделать? подскажите пожалуйста.
Este comentário foi feito pelo moderador no site
Olá Алексей,

Você não precisa modificar o código, basta adicionar o código VBA na planilha da célula que deseja referenciar.
Por exemplo, se você deseja filtrar uma tabela dinâmica chamada "Tabela Dinâmica 1"Em Sheet2 com base no valor da célula H6 in Sheet3, clique com o botão direito do mouse no Sheet3 guia planilha, clique em Ver código no menu do botão direito e, em seguida, adicione o código ao Planilha3 (Código) janela.
Não há comentários postados aqui ainda
Deixe o seu comentário
Postando como convidado
×
Avalie esta postagem:
0   Personagens
Locais sugeridos

Siga-nos

Copyright © 2009 - www.extendoffice.com. | Todos os direitos reservados. Distribuído por ExtendOffice. | | | Mapa do site
Microsoft e o logotipo do Office são marcas comerciais ou marcas registradas da Microsoft Corporation nos Estados Unidos e / ou em outros países.
Protegido por Sectigo SSL