Fóruns
Microsoft Excel - 2...
2024 - VBA & Macros
Simplificação de Có...
 
Notifications
Clear all

Simplificação de Código

 
2024 - VBA & Macros
Post Recente por gtsalikis 10 anos atrás
2 Posts
2 Usuários
0 Reactions
922 Visualizações
RSS
 BrUnOaFs
(@brunoafs)
Posts: 195
Reputable Member
Topic starter
 

Boa noite,

Fiz um código 'amador', porém está muito pesado.

Demora certa de 3 minutos ou mais para finalizar.

Private Sub FormulaImportCC()

Application.ScreenUpdating = False
    
Dim Linha As Integer
Dim UltimaLinha As Integer

UltimaLinha = Plan35.Cells(Rows.Count, "A").End(xlUp).Row

    For Linha = 3 To UltimaLinha
    
    Cells(Linha, 3).Select
    ActiveCell.FormulaR1C1 = "=SUM(RC[-2]-RC[-1])"
    
    Next Linha
    
Application.StatusBar = "Atualizando dados... 35% Concluídos!"
    
    For Linha = 3 To UltimaLinha
    
    Cells(Linha, 4).Select
    ActiveCell.FormulaR1C1 = "=IFERROR(RC[-1]/RC[-3],""-"")"
    
    Next Linha
    
Application.StatusBar = "Atualizando dados... 50% Concluídos!"
    
    For Linha = 3 To UltimaLinha
    
    Cells(Linha, 5).Select
    ActiveCell.FormulaR1C1 = "=IF(RC[-4]<>0,IF(RC[-1]>=0,1,-1),IF(AND(RC[-4]=0,RC[-3]<>0),0,""-""))"
    
    Next Linha
    
Application.StatusBar = "Atualizando dados... 65% Concluídos!"
    
    For Linha = 3 To UltimaLinha
    
    Cells(Linha, 8).Select
    ActiveCell.FormulaR1C1 = "=SUM(RC[-2]-RC[-1])"
    
    Next Linha
    
Application.StatusBar = "Atualizando dados... 80% Concluídos!"
    
    For Linha = 3 To UltimaLinha
    
    Cells(Linha, 9).Select
    ActiveCell.FormulaR1C1 = "=IFERROR(RC[-1]/RC[-3],""-"")"
    
    Next Linha
    
Application.StatusBar = "Atualizando dados... 90% Concluídos!"
    
    For Linha = 3 To UltimaLinha
    
    Cells(Linha, 10).Select
    ActiveCell.FormulaR1C1 = "=IF(RC[-4]<>0,IF(RC[-1]>=0,1,-1),IF(AND(RC[-4]=0,RC[-3]<>0),0,""-""))"
    
    Next Linha
    
End Sub
 
Postado : 16/03/2015 8:19 pm
 gtsalikis
(@gtsalikis)
Posts: 2373
Noble Member
 

Tente assim:

Private Sub FormulaImportCC()

With Application
    .ScreenUpdating = False
    .EnableEvents = False
    .Calculation = xlCalculationManual
End With
    
Dim Linha As Integer
Dim UltimaLinha As Integer

UltimaLinha = Plan35.Cells(Rows.Count, "A").End(xlUp).Row

For Linha = 3 To UltimaLinha
    Cells(Linha, 3).FormulaR1C1 = "=SUM(RC[-2]-RC[-1])"
    Cells(Linha, 4).FormulaR1C1 = "=IFERROR(RC[-1]/RC[-3],""-"")"
    Cells(Linha, 5).FormulaR1C1 = "=IF(RC[-4]<>0,IF(RC[-1]>=0,1,-1),IF(AND(RC[-4]=0,RC[-3]<>0),0,""-""))"
    Cells(Linha, 8).FormulaR1C1 = "=SUM(RC[-2]-RC[-1])"
    Cells(Linha, 9).FormulaR1C1 = "=IFERROR(RC[-1]/RC[-3],""-"")"
    Cells(Linha, 10).FormulaR1C1 = "=IF(RC[-4]<>0,IF(RC[-1]>=0,1,-1),IF(AND(RC[-4]=0,RC[-3]<>0),0,""-""))"
Next Linha
    
With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = xlCalculationAutomatic
End With
    
End Sub

Lembre-se de AGRADECER aos que te ajudaram, e de marcar o tópico como [Resolvido]
Gente que cuida de gente.

Gilmar

 
Postado : 16/03/2015 10:39 pm
Forum Jump:
  Tópico Anterior
Próximo Tópico