Excel Otimização de codigo VBA para melhorar tempo de execução

[Deividson]

Pessoal, boa tarde!

   Estou precisando de ajuda em um codigo do VBA que escrevi , como estou aprendendo e é o primeiro codigo que estou escrevendo , estou certo que há muitas oportunidades de otimização.

   Tenho uma planilha chamada Dados que uso de base para fazer os calculos, esta planilha tem 13k de linhas Aproximadamente

a ideia do codigo é a seguinte :

fazer a leitura dos dados da planilha e selecionar somente o conjunto de valores que atenderem 2 condições, colunas E e F, que estão na planilha resumo. 

E com este conjunto de dados executar a função forcast

E demostrar o resultado na coluna AZ da planilha resumo da linha correspondente as restrições

 

Exemplo

Coluna E|   Coluna F|    ...|   Coluna az|

Restrição1  Restrição 2        Resultado do forcast usando os dados retirados da base que atendiam as restrições 1 e 2

Restrição 3 Restrição 4        Resultado do forcast usando os dados retirados da base que atendiam as restrições 3 e 4

 

na pratica o codigo está funcionando, porém demora bastante para executar.

Teria alguma forma de otimizar para ele executar mais rápido?

 

Obrigado

 

Option Explicit
Function Previsão_regressão()
'Declaração de variaveis
Dim Itens() As Variant
Dim Variavelx() As Double
Dim Variavely() As Variant
Dim UltimaLinha As Integer
Dim i As Integer
Dim Indice As Integer
Dim data As Double
Dim resultado As Double
Dim IndiceValorProcurado As Integer
Dim UltimaLinhaResumo As Integer
Dim Dados As Worksheet
Dim Resumo As Worksheet
Dim WrkB  As Workbook
Dim WrkSDados As Worksheet
Dim WrkSResumo As Worksheet
Set WrkB = ThisWorkbook
Set WrkSDados = WrkB.Sheets("Dados")
Set WrkSResumo = WrkB.Sheets("Resumo")
WrkSResumo.Range("at2").NumberFormat = "0.00"


Application.Calculation = xlCalculationManual
data = WrkSResumo.Range("at2").Value


IndiceValorProcurado = 4


Indice = 1 ' atribui valor 1 para o indice

UltimaLinha = WrkSDados.Cells(Rows.Count, "n").End(xlUp).Row ' verifica o valor da ultima linha preenchida
UltimaLinhaResumo = WrkSResumo.Cells(Rows.Count, "f").End(xlUp).Row


WrkSDados.Range("j1:j" & UltimaLinha).NumberFormat = "0.00"
Retorno:

If WrkSResumo.Range("ak" & IndiceValorProcurado) > 3 Then

    ReDim Itens(1 To UltimaLinha, 1 To 16) 'Redimenciona a matriz de 1 ate a ultima linha
    Itens() = WrkSDados.Range("a1:p" & UltimaLinha) ' preenche a matriz com os dados entre as colunas A1 e P
    ReDim Variavely(1 To UltimaLinha) 'Redimenciona a matriz de 1 ate a ultima linha
    ReDim Variavelx(1 To UltimaLinha) 'Redimenciona a matriz de 1 ate a ultima linha
    
    For i = LBound(Itens) To UBound(Itens) ' laço de repetição
        If Itens(i, 14) = WrkSResumo.Range("f" & IndiceValorProcurado) And Itens(i, 5) = WrkSResumo.Range("e" & IndiceValorProcurado) Then   'verifica se os itens na matriz é igual a célula do testo do itens
        Variavely(Indice) = Itens(i, 16) 'preenche o valor  na matriz
        Variavelx(Indice) = Itens(i, 10) 'preenche o valor  na matriz
        Indice = Indice + 1 'soma +1 no valor do indice
       
        
        End If
        
     
    Next i
     
    
    
resultado = Application.WorksheetFunction.Forecast(data, Variavely, Variavelx)
WrkSResumo.Range("az" & IndiceValorProcurado) = resultado
End If

If IndiceValorProcurado < UltimaLinhaResumo Then

    IndiceValorProcurado = IndiceValorProcurado + 1
    GoTo Retorno
End If

WrkSResumo.Range("at2").NumberFormat = "dd/mm/yyyy"
WrkSDados.Range("j1:j" & UltimaLinha).NumberFormat = "dd/mm/yyyy"

Application.Calculation = xlCalculationAutomatic

End Function

 

 

[Edson Luiz Branco]

Boa tarde, @Deividson

 

15 horas atrás, Deividson disse:

como...é o primeiro  codigo que estou escrevendo...

 

Por favor, anexe seu modelo (descaracterize informações confidenciais, se necessário), pelo menos com uma generosa quantidade de registros, pois fica bem mais complicado fazer testes como esse de performance sem uma base de dados de apoio.