Filtrar campo de Tabela Dinamica (VBA)

Boa noite!!

Usar célula para filtrar campo de tabela dinâmica

Código:

Option Explicit

Sub FiltrarCampoTD()
'Filtrar determinado campo de TD via celula
Dim objPivotField As PivotField
Dim objPivotItem As PivotItem
Set objPivotField = _
    ActiveSheet.PivotTables(1).PivotFields(Index:="NomeCampo")
    ActiveSheet.PivotTables("NomeTabelaDinamica").ClearAllFilters
        For Each objPivotItem In objPivotField.PivotItems
            If objPivotItem.Name = Range("Celula") Then
              objPivotItem.Visible = True
              Else
              objPivotItem.Visible = False
            End If
        Next objPivotItem
    ActiveWorkbook.RefreshAll
End Sub


Att

Boa tarde.
Gostaria de uma forma mais rápida para desmarcar os filtros diferentes da célula com a informação. Ele fica lendo várias vezes o filtro e desmarcando o resto. Tem uma forma de desmarcar tudo de uma vez, exceto o filtro?

Aliás, excelente compartilhamento. Obrigado!

Boa noite!!

Abra um tópico, deposite seu modelo em site gratuito, depois poste seu link aqui!!

Att

Boa tarde.

Segue, https://usuariosdoexcel.forumeiros.com/t166-filtrar-conteudo-de-tabela-dinamica#477


Obrigado.

alexandrevba escreveu:Boa noite!!

Usar célula para filtrar campo de tabela dinâmica

Código:

Option Explicit

Sub FiltrarCampoTD()
'Filtrar determinado campo de TD via celula
Dim objPivotField As PivotField
Dim objPivotItem As PivotItem
Set objPivotField = _
    ActiveSheet.PivotTables(1).PivotFields(Index:="NomeCampo")
    ActiveSheet.PivotTables("NomeTabelaDinamica").ClearAllFilters
        For Each objPivotItem In objPivotField.PivotItems
            If objPivotItem.Name = Range("Celula") Then
               objPivotItem.Visible = True
              Else
               objPivotItem.Visible = False
            End If
        Next objPivotItem
    ActiveWorkbook.RefreshAll
End Sub


Att

Valeu Mesmo Alexandre! Mas não está funcionando com datas, comparando a data 01/01/2015 na celula A1 com a que está no filtro da dinamica dá FALSO! O depurador acusa tipos incompativeis no objPivotItem.

----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------

Achei a solução pessoal!
Reformulei o código: formato a data como padrão norte americano, comparo a data formatada com a da lista do filtro, se existir eu formato a data para o padrão brasileiro e atribuo a data ao filtro.
Espero que isso ajude o pessoal que precise trabalhar setando datas abreviadas (dd/mm/aaaa) na Tabela Dinamica por VBA.
Código Funcional:

Dim DataFormatada As Date
Dim objPivotField As PivotField
Dim objPivotItem As PivotItem
DataFormatada = Format(Range("CELULA QUE ESTÁ A DATA").Value, "m/d/yyyy")

Set objPivotField = ActiveSheet.PivotTables("DinamicaData").PivotFields(Index:="Data")
   ActiveSheet.PivotTables("TabelaDinamicaData").PivotFields("Data").ClearAllFilters
   
       For Each objPivotItem In objPivotField.PivotItems
           If objPivotItem.Name = DataFormatada Then          
             DataFormatada = Format(Range("CELULA QUE ESTÁ A DATA").Value, "dd/mm/yyyy")
             ActiveSheet.PivotTables("TabelaDinamicaData").PivotFields("Data").CurrentPage = Range("C2").Value
             Else              
           End If
       Next objPivotItem
   
   
ActiveSheet.ChartObjects("Gráfico 1").Activate
ActiveChart.ChartTitle.Text = "Data - " & Range("CELULA DO FILTRO DE DATA DA TABELA DINAMICA").Value
If ActiveChart.ChartTitle.Text = "Data - (Tudo)" Then MsgBox "Sem dados para os critérios selecionados", vbInformation, "Atenção"