Preciso de uma ajuda com o código abaixo, pois não tenho muitos conhecimentos de VBA. Este código eu consegui através do Chat GPT ele funciona do jeito que eu quero, porem ele é muito lento demora mais de 30 segundos para executar o filtro na tabela dinâmica de acordo com os valores selecionados na tabela externa. Como otimizar este código para deixa-lo mais rápido ao executar o filtro?
Sub FiltrarPNC()
Dim wsMaquinas As Worksheet
Dim wsRelatorioBase As Worksheet
Dim ptRelatorio As PivotTable
Dim pfPNC As PivotField
Dim piPNC As PivotItem
Dim rngCodigos As Range
Dim celCodigo As Range
Dim arrCodigos() As String
Dim i As Long
' Define as planilhas e a tabela dinâmica a ser filtrada
Set wsMaquinas = ThisWorkbook.Sheets("MÁQUINAS")
Set wsRelatorioBase = ThisWorkbook.Sheets("RELATÓRIO_BASE")
Set ptRelatorio = wsRelatorioBase.PivotTables("RELATÓRIO")
' Define o campo PNC da tabela dinâmica
Set pfPNC = ptRelatorio.PivotFields("PNC")
' Limpa o filtro anterior do campo PNC
pfPNC.ClearAllFilters
' Define a faixa de células com os códigos da tabela PRODUTOS
Set rngCodigos = wsMaquinas.Range("PRODUTOS[CÓDIGO]")
' Percorre as células da faixa de códigos e adiciona os valores a um array
For Each celCodigo In rngCodigos
If celCodigo.Value <> "" Then
ReDim Preserve arrCodigos(i)
arrCodigos(i) = celCodigo.Value
i = i + 1
End If
Next celCodigo
' Filtra o campo PNC com os valores do array de códigos
For Each piPNC In pfPNC.PivotItems
If IsInArray(piPNC.Value, arrCodigos) Then
piPNC.Visible = True
Else
piPNC.Visible = False
pfPNC.ClearAllFilters
End If
Next piPNC
End Sub
Editado por Ronaldo Marques FALTOU UMA LINHA DO CÓDIGO
Pergunta
Ronaldo Marques
Bom dia a Todos,
Preciso de uma ajuda com o código abaixo, pois não tenho muitos conhecimentos de VBA. Este código eu consegui através do Chat GPT ele funciona do jeito que eu quero, porem ele é muito lento demora mais de 30 segundos para executar o filtro na tabela dinâmica de acordo com os valores selecionados na tabela externa. Como otimizar este código para deixa-lo mais rápido ao executar o filtro?
Sub FiltrarPNC()
Dim wsMaquinas As Worksheet
Dim wsRelatorioBase As Worksheet
Dim ptRelatorio As PivotTable
Dim pfPNC As PivotField
Dim piPNC As PivotItem
Dim rngCodigos As Range
Dim celCodigo As Range
Dim arrCodigos() As String
Dim i As Long
' Define as planilhas e a tabela dinâmica a ser filtrada
Set wsMaquinas = ThisWorkbook.Sheets("MÁQUINAS")
Set wsRelatorioBase = ThisWorkbook.Sheets("RELATÓRIO_BASE")
Set ptRelatorio = wsRelatorioBase.PivotTables("RELATÓRIO")
' Define o campo PNC da tabela dinâmica
Set pfPNC = ptRelatorio.PivotFields("PNC")
' Limpa o filtro anterior do campo PNC
pfPNC.ClearAllFilters
' Define a faixa de células com os códigos da tabela PRODUTOS
Set rngCodigos = wsMaquinas.Range("PRODUTOS[CÓDIGO]")
' Percorre as células da faixa de códigos e adiciona os valores a um array
For Each celCodigo In rngCodigos
If celCodigo.Value <> "" Then
ReDim Preserve arrCodigos(i)
arrCodigos(i) = celCodigo.Value
i = i + 1
End If
Next celCodigo
' Filtra o campo PNC com os valores do array de códigos
For Each piPNC In pfPNC.PivotItems
If IsInArray(piPNC.Value, arrCodigos) Then
piPNC.Visible = True
Else
piPNC.Visible = False
pfPNC.ClearAllFilters
End If
Next piPNC
End Sub
FALTOU UMA LINHA DO CÓDIGO
Link para o comentário
Compartilhar em outros sites
0 respostass a esta questão
Posts Recomendados
Participe da discussão
Você pode postar agora e se registrar depois. Se você já tem uma conta, acesse agora para postar com sua conta.