Ir ao conteúdo
  • Cadastre-se
FelipeAmorim

Excel RESOLVIDO VBA - Unificar mais de um "Worksheet_Change"

Posts recomendados

Pessoal, podem me ajudar por favor?

 

Contextualizando, descobri um código que ao inserir um parâmetro em uma célula, ele ativa o filtro da tabela dinâmica em outra sheet. Por exemplo, na sheet "Dashbord", eu digito o ano 2018 na célula "E9", e automaticamente é ativado o filtro "Ano" na tabela dinâmica da sheet "Dinamicas". Este código é um "Worksheet_Change". O problema é que preciso filtrar mais de um parâmetro e em mais de uma tabela dinâmica. Por exemplo, preciso digitar os parâmetros  "Ano" e "Unidade" na sheet "Dashboard" e ativar o filtro na "tabela1" e "tabela2 da sheet "Dinamicas".

 

 Como eu poderia unificar estas quatro "Worksheet_Change"?

 

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim xPTable As PivotTable
    Dim xPFile As PivotField
    Dim xStr As String
    On Error Resume Next
    If Intersect(Target, Range("E9")) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Set xPTable = Worksheets("Dinamicas").PivotTables("Tabela1")
    Set xPFile = xPTable.PivotFields("Ano")
    xStr = Target.Text
    xPFile.ClearAllFilters
    xPFile.CurrentPage = xStr
    Application.ScreenUpdating = True
End Sub

 

 

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim xPTable As PivotTable
    Dim xPFile As PivotField
    Dim xStr As String
    On Error Resume Next
    If Intersect(Target, Range("E10")) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Set xPTable = Worksheets("Dinamicas").PivotTables("Tabela1")
    Set xPFile = xPTable.PivotFields("Unidade")
    xStr = Target.Text
    xPFile.ClearAllFilters
    xPFile.CurrentPage = xStr
    Application.ScreenUpdating = True
End Sub

 

 

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim xPTable As PivotTable
    Dim xPFile As PivotField
    Dim xStr As String
    On Error Resume Next
    If Intersect(Target, Range("E9")) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Set xPTable = Worksheets("Dinamicas").PivotTables("Tabela2")
    Set xPFile = xPTable.PivotFields("Ano")
    xStr = Target.Text
    xPFile.ClearAllFilters
    xPFile.CurrentPage = xStr
    Application.ScreenUpdating = True

 


End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim xPTable As PivotTable
    Dim xPFile As PivotField
    Dim xStr As String
    On Error Resume Next
    If Intersect(Target, Range("E10")) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Set xPTable = Worksheets("Dinamicas").PivotTables("Tabela2")
    Set xPFile = xPTable.PivotFields("Unidade")
    xStr = Target.Text
    xPFile.ClearAllFilters
    xPFile.CurrentPage = xStr
    Application.ScreenUpdating = True
End Sub
 

 

Obrigado

 

Felipe

Compartilhar este post


Link para o post
Compartilhar em outros sites

O primeiro e o terceiro códigos são iguais.

No terceiro não seria "Tabela2" ?

 

Compartilhar este post


Link para o post
Compartilhar em outros sites

Olá Osvaldo.

 

você tem razão, no terceiro é tabela2. Eu já editei o post.

 

Obrigado pela observação.

 

 

Compartilhar este post


Link para o post
Compartilhar em outros sites

Olá, Felipe.

Veja se funciona como desejado.

Private Sub Worksheet_Change(ByVal Target As Range)
 Dim xPTable As PivotTable, xPFile As PivotField, xStr As String
  On Error Resume Next
 
  If Target.Address = "$E$9" Then
   Application.ScreenUpdating = False
   Set xPTable = Worksheets("Dinamicas").PivotTables("Tabela1")
   Set xPFile = xPTable.PivotFields("Ano")
   xStr = Target.Text
   xPFile.ClearAllFilters
   xPFile.CurrentPage = xStr
   Set xPTable = Worksheets("Dinamicas").PivotTables("Tabela2")
   Set xPFile = xPTable.PivotFields("Ano")
   xPFile.ClearAllFilters
   xPFile.CurrentPage = xStr
   Application.ScreenUpdating = True
   
  ElseIf Target.Address = "$E$10" Then
   Application.ScreenUpdating = False
   Set xPTable = Worksheets("Dinamicas").PivotTables("Tabela1")
   Set xPFile = xPTable.PivotFields("Unidade")
   xStr = Target.Text
   xPFile.ClearAllFilters
   xPFile.CurrentPage = xStr
   Set xPTable = Worksheets("Dinamicas").PivotTables("Tabela2")
   Set xPFile = xPTable.PivotFields("Unidade")
   xPFile.ClearAllFilters
   xPFile.CurrentPage = xStr
   Application.ScreenUpdating = True
  End If
End Sub

obs. mantive o tratamento de erro mas não sei qual a função dele nesse código; em algum lugar do código deveria ser inserido On Error GoTo 0 com o fim de resetar

  • Curtir 1

Compartilhar este post


Link para o post
Compartilhar em outros sites

Olá Osvaldo.

 

Funcionou perfeitamente. Muito obrigado.

 

Quanto ao tratamento de erro, eu também não sei a função dele porque eu obtive o código da internet e com sua ajuda apliquei para minha necessidade, que era uma quantidade maior de filtros e tabelas. Mas de qualquer forma funcionou normalmente. 

 

Novamente muito obrigado pela ajuda.

 

Abs

 

 

  • Curtir 1

Compartilhar este post


Link para o post
Compartilhar em outros sites

Crie uma conta ou entre para comentar

Você precisar ser um membro para fazer um comentário

Criar uma conta

Crie uma nova conta em nossa comunidade. É fácil!

Crie uma nova conta

Entrar

Já tem uma conta? Faça o login.

Entrar agora





Sobre o Clube do Hardware

No ar desde 1996, o Clube do Hardware é uma das maiores, mais antigas e mais respeitadas publicações sobre tecnologia do Brasil. Leia mais

Direitos autorais

Não permitimos a cópia ou reprodução do conteúdo do nosso site, fórum, newsletters e redes sociais, mesmo citando-se a fonte. Leia mais

×
×
  • Criar novo...

GRÁTIS: minicurso “Como ganhar dinheiro montando computadores”

Gabriel TorresGabriel Torres, fundador e editor executivo do Clube do Hardware, acaba de lançar um minicurso totalmente gratuito: "Como ganhar dinheiro montando computadores".

Você aprenderá sobre o quanto pode ganhar, como cobrar, como lidar com a concorrência, como se tornar um profissional altamente qualificado e muito mais!

Inscreva-se agora!