Ir ao conteúdo
  • Cadastre-se

Excel VBA - Unificar mais de um "Worksheet_Change"


Ir à solução Resolvido por Visitante,

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

Link para o comentário
Compartilhar em outros sites

  • Solução

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

Link para o comentário
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

 

 

Link para o comentário
Compartilhar em outros sites

Crie uma conta ou entre para comentar

Você precisa ser um usuário 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 comunidades 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...