O Excel foi feito para facilitar nossas vidas, deixando tudo extremamente mais rápido de ser calculado, visualizado e organizado. Porém, nunca estamos satisfeitos, e conforme nossos arquivos crescem eles também ficam mais lentos, levando alguns segundos ou as vezes minutos para calcular tudo.
E num mar de abas e fórmulas as vezes fica difícil determinar o que exatamente está causando essa lentidão no cálculo, e logo, difícil de solucionar o problema.
Neste artigo você verá um código de macro que irá te dizer exatamente quanto tempo cada conjunto de células, planilha ou arquivo como um todo leva para ser calculado. Com isso você saberá identificar onde está o problema e assim corrigir tudo.
Arquivos muito pesados
Antes de ir ao código de macro e a solução proposta neste artigo, primeiro vamos dar uma olhada no tamanho desse seu arquivo Excel aí.
As vezes os nossos arquivos ficam muito pesados tendo vários e vários megabites de tamanho e, em geral, algo está errado nisso, e deixa o cálculo da planilha extremamente lento.
Se este for o seu caso, arquivo muito pesado, confira este outro artigo onde ensino a como diminuir o peso de um arquivo Excel.
Com preguiça de ler? Assista ao vídeo
Como funciona
O código de macro deste artigo possui na verdade 5 códigos embutidos, são eles:
- TempoArea
Calcula o tempo que a área seleciona na planilha demora para ser calculada. - TempoAba
Calcula o tempo que a aba atual demora para ser calculada. - TempoPlanilha
Calcula o tempo que o arquivo atual demora para ser calculado. - TempoExcel
Calcula o tempo que todos os arquivos Excel abertos no momento demoram para ser calculados. - TempoTodasAbas
Calcula o tempo que cada aba da planilha atual demora para ser calculado individualmente.
Para todos os casos, uma mensagem será exibida na tela apresentando o tempo que levou para o cálculo ser finalizado.
O código
Para utilizar o código abaixo, siga os passos.
- Aperte ALT + F11 para abrir o editor VBA.
- Na parte esquerda da tela que se abre, clique com o botão direito numa área vazia e selecione Inserir > Módulo.
- Clique duas vezes sobre o Módulo recém-criado para abri-lo.
- Copie o código abaixo e cole-o no lado direito da tela.
- Feche o editor VBA.
#If VBA7 Then
Private Declare PtrSafe Function getFrequency Lib "kernel32" _
Alias "QueryPerformanceFrequency" (cyFrequency As Currency) As Long
Private Declare PtrSafe Function getTickCount Lib "kernel32" _
Alias "QueryPerformanceCounter" (cyTickCount As Currency) As Long
#Else
Private Declare Function getFrequency Lib "kernel32" _
Alias "QueryPerformanceFrequency" (cyFrequency As Currency) As Long
Private Declare Function getTickCount Lib "kernel32" _
Alias "QueryPerformanceCounter" (cyTickCount As Currency) As Long
#End If
Function MicroTimer() As Double
' Segundos
Dim cyTicks1 As Currency
Static cyFrequency As Currency
MicroTimer = 0
' Busca frequência
If cyFrequency = 0 Then getFrequency cyFrequency
' Busca os ticks
getTickCount cyTicks1
' Segundos
If cyFrequency Then MicroTimer = cyTicks1 / cyFrequency
End Function
Sub TempoArea()
DoCalcTimer 1
End Sub
Sub TempoAba()
DoCalcTimer 2
End Sub
Sub TempoPlanilha()
DoCalcTimer 3
End Sub
Sub TempoExcel()
DoCalcTimer 4
End Sub
Sub TempoTodasAbas()
DoCalcTimer 5
End Sub
Sub DoCalcTimer(jMethod As Long)
Dim dTime As Double
Dim dOvhd As Double
Dim oRng As Range
Dim oCell As Range
Dim oArrRange As Range
Dim sCalcType As String
Dim lCalcSave As Long
Dim bIterSave As Boolean
On Error GoTo Errhandl
' Inicia
dTime = MicroTimer
' Salva as configurações de cálculo
lCalcSave = Application.Calculation
bIterSave = Application.Iteration
If Application.Calculation <> xlCalculationManual Then
Application.Calculation = xlCalculationManual
End If
Select Case jMethod
Case 1
' Desliga interações.
If Application.Iteration <> False Then
Application.Iteration = False
End If
' Max range usado.
If Selection.Count > 1000 Then
Set oRng = Intersect(Selection, Selection.Parent.UsedRange)
Else
Set oRng = Selection
End If
' Incluir matrizes fora da área selecionada.
For Each oCell In oRng
If oCell.HasArray Then
If oArrRange Is Nothing Then
Set oArrRange = oCell.CurrentArray
End If
If Intersect(oCell, oArrRange) Is Nothing Then
Set oArrRange = oCell.CurrentArray
Set oRng = Union(oRng, oArrRange)
End If
End If
Next oCell
sCalcType = "Cálculo de " & CStr(oRng.Count) & _
" célula(s) na área selecionada: "
Case 2
sCalcType = "Cálculo da aba " & ActiveSheet.Name & ": "
Case 3
sCalcType = "Cálculo da planilha atual: "
Case 4
sCalcType = "Cálculo completo das planilhas abertas: "
Case 5
sCalcType = "Cálculo de cada aba da planilha atual: "
End Select
' Busca tempo de início
dTime = MicroTimer
Select Case jMethod
Case 1
If Val(Application.Version) >= 12 Then
oRng.CalculateRowMajorOrder
Else
oRng.Calculate
End If
Case 2
ActiveSheet.Calculate
Case 3
Application.Calculate
Case 4
Application.CalculateFull
Case 5
Dim WS As Worksheet
For Each WS In ThisWorkbook.Worksheets
WS.Calculate
dTime = MicroTimer - dTime
dTime = Round(dTime, 5)
MsgBox sCalcType & vbNewLine & WS.Name & ": " & CStr(dTime) & " segundos", vbOKOnly + vbInformation, "TempoCalc"
dTime = MicroTimer
Next WS
' Reestabelece métodos de cálculo
If Application.Calculation <> lCalcSave Then
Application.Calculation = lCalcSave
End If
If Application.Iteration <> bIterSave Then
Application.Calculation = bIterSave
End If
Exit Sub
End Select
' Duração do cálculo
dTime = MicroTimer - dTime
On Error GoTo 0
dTime = Round(dTime, 5)
MsgBox sCalcType & " " & vbNewLine & CStr(dTime) & " segundos", _
vbOKOnly + vbInformation, "TempoCalc"
Finish:
' Reestabelece métodos de cálculo
If Application.Calculation <> lCalcSave Then
Application.Calculation = lCalcSave
End If
If Application.Iteration <> bIterSave Then
Application.Calculation = bIterSave
End If
Exit Sub
Errhandl:
On Error GoTo 0
MsgBox "Incapaz de calcular " & sCalcType, _
vbOKOnly + vbCritical, "TempoCalc"
GoTo Finish
End Sub
Atenção
É possível que as primeiras linhas do código fiquem vermelhas, indicando erro, isso é porque existe uma condição SE ali, que avalia se o seu Excel é 32 ou 64 bits. Dependendo de qual for, o código executado é diferente, assim, o código que não é compatível com seu Excel aparecerá como se fosse um erro.
Rodando o código
Agora que já temos os código prontos, basta executá-los, para isso siga os passos abaixo.
- Aperte ALT + F8 para abrir a caixa de macros.
- Na lista à esquerda, selecione a macro que deseja executar.
- Clique no botão Executar.