Otimizar para cada loop na tabela dinâmica

Question

Estou tendo dificuldade em otimizar um loop For Each do VBA que precisa analisar 10-15k linhas em uma Tabela Dinâmica que é baseada em uma Tabela do Excel, tudo na mesma pasta de trabalho. Atualmente, isso leva cerca de 2 minutos para ser concluído, o que eu gostaria de melhorar, já que uso isso em reuniões.

Eu pesquisei e encontrei algumas sugestões interessantes, como desabilitar a Atualização de Tela, Cálculos Manuais e " dim " minhas variáveis como outros tipos de dados, mas não obtive diferença de velocidade. Eu estou supondo que o loop For Each simplesmente não é destinado a esse propósito.

Enquanto lia esta postagem do Super User, parece como eu poderia colocar os valores relevantes em um "Dicionário" e seria muito rápido. O fato de eu ter dois itens para filtrar torna isso um pouco mais complicado para mim.

Eu estou "aprendendo fazendo" e não pretendo ser um programador de VBA, então realmente qualquer ajuda é muito apreciada!

Dim pvtTable As PivotTable
Dim pvtField1, pvtField2 As PivotField
Dim pvtItem1, pvtItem2 As PivotItem

Set ws = ActiveSheet
Set pvtTable = ws.PivotTables("PTReport")
Set pvtField1 = pvtTable.PivotFields("callNummer")
Set pvtField2 = pvtTable.PivotFields("Destination")

Application.ScreenUpdating = False

For Each pvtItem1 In pvtField1.PivotItems
  If InStr(UCase(pvtItem1), "STORE") > 0 Then
    pvtItem1.Visible = True
  Else
    pvtItem1.Visible = False
  End If
Next

For Each pvtItem2 In pvtField2.PivotItems
  If InStr(UCase(pvtItem2), "221") > 0 Then
    pvtItem2.Visible = True
  Else
    pvtItem2.Visible = False
  End If
Next

Application.ScreenUpdating = True

Se eu puder esclarecer alguma coisa ou fornecer mais detalhes, por favor me avise.

    

Answer 1

Eu suspeito que as chamadas de 20-30K para InStr(UCase()) sejam o problema. Eu sugiro que você defina algumas colunas auxiliares. Por exemplo, se os dados de "callNummer" e "Destination" estiverem nas colunas A e B , defina

• Y1 → =IFERROR(SEARCH("store", A1), 0)
• Z1 → =IFERROR(SEARCH("221", B1), 0)

e, em seguida, altere seu código VBA para verificar se Yn e Zn são > 0 . Desta forma, a verificação da cadeia de caracteres é feita sempre que os dados "callNummer" e "Destination" forem modificados, e há muito menos trabalho para a rotina do VBA. E, claro, você pode ocultar as colunas auxiliares quando tudo estiver funcionando.

Não sei exatamente como traduzir suas declarações pvtItemN.Visible = … neste framework.

Mas mesmo que você não consiga fazer isso funcionar, você pode mudar o teste InStr(UCase(pvtItem2), "221") para InStr(pvtItem2, "221") . Se tudo o que você procura é um número, não há motivo para converter o conteúdo alfabético da célula em maiúsculas.

    

Answer 2

Pouco antes do primeiro loop de ... next, adicione o seguinte código:

Dim saveCalc as xlCalculation

With Application
   .ScreenUpdating = False
   saveCalc = .Calculation
   .Calculation = xlCalculationManual
End With

Depois do segundo loop de ... next, adicione o seguinte código:

With Application
    .ScreenUpdating = True
    .Calculation = saveCalc
End With