Notifications
Clear all

[Resolvido] Macro (Change) nao roda até o final


JokerPot
(@jokerpot)
Estimable Member Registered
Entrou: 7 anos atrás
Posts: 132
Topic starter  

Pessoal Boa Tarde!

Estou tentando fazer uma macro dentro da planilha utilizando o evento CHANGE, porem esta ocorrendo um erro que nao sei o que pode ser.

 

A rotina deve atualizar uma tabela dinamica e classificar os 5 maiores valores.

 

Não sei por qual motivo a rotina lê apenas a primeira linha de atualização da tabela dinamica e volta para o inicio sem continuar nas proximas linhas.

 

Sabem me dizer o que pode ser??

Anexei a planilha com o exemplo.

 

 


ResponderCitar (Quote)
EdsonBR
(@edsonbr)
Prominent Member Moderator
Entrou: 6 anos atrás
Posts: 793
 

Boa tarde, @jokerpot

 
Postado por: @jokerpot

Sabem me dizer o que pode ser??

Quando ocorre o Refresh na Tabela Dinâmica, o Excel dispara novamente o evento Change por isso fica em Loop infinito e não seu código não avança. Para contornar o problema, desative a armadilha de eventos logo antes de atualizar a TD, não esquecendo de reativar antes de encerrar:

Private Sub Worksheet_Change(ByVal Target As Range)
  On Error GoTo RestauraEventos
  If Not Intersect(Target, Range("L4")) Is Nothing Then
    Application.EnableEvents = False
      PERIODO = Range("S2").Value
        Me.PivotTables("Tabela dinâmica1").PivotCache.Refresh
        Me.PivotTables("Tabela dinâmica1").PivotFields("Info").ClearAllFilters
        Me.PivotTables("Tabela dinâmica1").PivotFields("Info").PivotFilters. _
            Add2 Type:=xlTopCount, DataField:=ActiveSheet.PivotTables( _
            "Tabela dinâmica1").PivotFields(PERIODO), Value1:=5
  End If
RestauraEventos:
    Application.EnableEvents = True
    If Err.Number <> 0 Then Error (Err.Number)
End Sub


JokerPot curtiu
ResponderCitar (Quote)
JokerPot
(@jokerpot)
Estimable Member Registered
Entrou: 7 anos atrás
Posts: 132
Topic starter  

@edsonbr Boa Tarde!

 

Muito obrigado pela ajuda.

Não me atentei a isso.

Resolveu meu problema.

 

abraços.


ResponderCitar (Quote)