Fóruns
Microsoft Excel - 2...
VBA & Macros
Ajuda tornar Macro ...
 
Notifications
Clear all

Ajuda tornar Macro mais rápida

 
VBA & Macros
Post Recente por Raygsson 3 anos atrás
4 Posts
3 Usuários
1 Likes
1,190 Visualizações
RSS
 TutoElizeu
(@tutoelizeu)
Posts: 160
Estimable Member
Topic starter
 

Bom dia Mestres!

Gostaria de pedir uma ajuda se vocês puderem, eu fiz uma macro que traz um relatório, funciona, porém demora quase dois minutos para gerar,

Vocês conseguem me ajudar a torna-la mais rápida?

Coloquei um retângulo na Aba "Dashboard" que gera o relatório de Auditorias na Aba "Auditorias" 

Sub Auditorias()

Linha = 2
Linha2 = 3

Application.ScreenUpdating = False

Sheets("Auditorias").Select

'Limpar Auditorias
Sheets("Auditorias").Range("A3:H50").Clear

'Preencher Restriçãoatorio
Do While Sheets("Din_Gráfico").Cells(Linha, 66) <> ""
   If Sheets("Din_Gráfico").Cells(Linha, 66) = "OK" Then
    
        Sheets("Auditorias").Cells(Linha2, 1) = Sheets("Din_Gráfico").Cells(Linha, 63)  ' Facilitador
        Sheets("Auditorias").Cells(Linha2, 2) = Sheets("Din_Gráfico").Cells(Linha, 64)  ' Diretoria
        Sheets("Auditorias").Cells(Linha2, 3) = Sheets("Din_Gráfico").Cells(Linha, 65)  ' Area
        Sheets("Auditorias").Cells(Linha2, 4) = Sheets("Din_Gráfico").Cells(Linha, 66)  ' 1. Auditoria de Indicadores
        Sheets("Auditorias").Cells(Linha2, 5) = Sheets("Din_Gráfico").Cells(Linha, 67)  ' 2. Auditoria de Indicadores
        Sheets("Auditorias").Cells(Linha2, 6) = Sheets("Din_Gráfico").Cells(Linha, 68)  ' 3. Auditoria de Indicadores
        Sheets("Auditorias").Cells(Linha2, 7) = Sheets("Din_Gráfico").Cells(Linha, 69)  ' 4. Auditoria de Indicadores
              
        Linha2 = Linha2 + 1
    End If
    Linha = Linha + 1
Loop

Application.ScreenUpdating = True

End Sub

 

Muito obrigado!

 

 
Postado : 26/07/2021 10:13 am
 MPrudencio
(@mprudencio)
Posts: 2749
Famed Member
 

@tutoelizeu 

De forma generica nao ha muito o que fazer com relação a velocidade.

O que vc chama de lentidão???

Verifique se é possivel aumentar a memoria ram do pc, pq seu codigo esta bem limpo e nao tem nenhuma razao para que ele apresente lentidao de forma que seja necessario altera-lo.

 

Marcelo Prudencio
Microsoft Excel Brasil no Facebook

"Começar já é a metade do caminho."
Autor Desconhecido

Simplifica que simples fica.
Nicole Tomazella.

"O Simples é Sempre Melhor Que o Complicado"
Jorge Paulo Lemann.

 
Postado : 26/07/2021 10:24 am
TutoElizeu reacted
 TutoElizeu
(@tutoelizeu)
Posts: 160
Estimable Member
Topic starter
 

Obrigado Marcelo!

Consegui deixar mais rápido desativando o calculo automático

Application.Calculation = xlCalculationManual
Application.Calculation = xlCalculationAutomatic
 
Postado : 26/07/2021 11:56 am
Raygsson
 Raygsson
(@raygsson)
Posts: 68
Trusted Member
 

@tutoelizeu

Você vai conseguir um desempenho muito melhor trabalhando com vetor/matriz.

Pode carregar os dados numa matriz, fazer um loop nela e preencher uma segunda matriz com os resultados. Por fim pega esses resultados e cola tudo de uma vez na aba.

Fazer um "loop normal" e preencher os dados linha por linha consome um tempo desnecessário.

Num teste que fiz esse seu script demorou em média 3,5 segundos, utilizando matrizes levou em média 0,3 segundos pra fazer a mesma coisa.

 

Sub Auditorias()

Linha = 2
linha2 = 1

Application.ScreenUpdating = False
Sheets("Auditorias").Select
Sheets("Auditorias").Range("A3:H50").Clear

LinFim = Plan1.Range("BK2").End(xlDown).Row + 1
Din_Gráfico = Plan1.Range("BK2:BQ" & LinFim)
ReDim Auditoria(1 To LinFim, 1 To 7)

For Item = 1 To UBound(Din_Gráfico)
    If Din_Gráfico(Item, 4) = "OK" Then
        Auditoria(linha2, 1) = Din_Gráfico(Item, 1) ' Facilitador
        Auditoria(linha2, 2) = Din_Gráfico(Item, 2) ' Diretoria
        Auditoria(linha2, 3) = Din_Gráfico(Item, 3) ' Area
        Auditoria(linha2, 4) = Din_Gráfico(Item, 4) ' 1. Auditoria de Indicadores
        Auditoria(linha2, 5) = Din_Gráfico(Item, 5) ' 2. Auditoria de Indicadores
        Auditoria(linha2, 6) = Din_Gráfico(Item, 6) ' 3. Auditoria de Indicadores
        Auditoria(linha2, 7) = Din_Gráfico(Item, 7) ' 4. Auditoria de Indicadores
        linha2 = linha2 + 1
    End If
Next

Sheets("Auditorias").Range("A3:G" & LinFim) = Auditoria
Application.ScreenUpdating = True

End Sub
 
Postado : 26/07/2021 9:09 pm
Forum Jump:
  Tópico Anterior
Próximo Tópico