Código iterando lentamente

Question

Eu tenho uma macro simples que cria 16 versões diferentes de um modelo, atualizando obtendo valores de outra pasta de trabalho aberta. Está demorando mais de um minuto para iterar apenas 16 vezes e queria saber se havia uma maneira de acelerar isso? Vai se tornar um problema, porque eu eventualmente preciso iterar 64 + vezes.

Eu tenho a sensação de que o meu código é lento porque eu acesso planilhas com muita freqüência em meus loops. Eu também procurei possivelmente reduzir o número de comparações de cordas, mas isso não pareceu fazer muita diferença.

Obrigado

Sub getORSA()
Application.ScreenUpdating = False

Dim wb As Workbook, template As Workbook
Dim ws As Worksheet, ws2 As Worksheet
Dim scenario As Variant, scenario2 As Variant, division As Variant, analysis As Variant
Dim a As Variant, b As Variant, c As Variant, confirm As Variant
Dim iterations As Integer
Dim templatePath As String, path As String, name As String, extension As String
Dim result As String
Dim timeOn As Date, timeOff As Date

'check the user wants to run script
confirm = MsgBox("Run ORSA script?", vbYesNo)
If confirm = vbNo Then
    Exit Sub
End If

timeOn = Now

'initialise variables & objects
Set wb = ThisWorkbook
Set ws = wb.Worksheets("T.change")
scenario = Array("Base") ' while testing use just one scenario
scenario2 = Array("Base", "Base (2)", "Inflation", "Deflation")
division = Array("LGAS SHF", "LGPL SHF", "SRC", "FINANCE")
analysis = Array("GROUP EC", "GROUP SII", "LGAS EC", "LGAS SII")

'template variables and open template
templatePath = "\..."
path = "\..."
name = "ORSA_"
extension = ".xlsx"
Set template = Workbooks.Open(Filename:=templatePath)

iterations = 0

    For Each a In scenario
        For Each b In division
            For Each c In analysis

                'update values on template
                With template.Worksheets("EB")

                    ' --SET HEADERS ON TEMPLATE -- '

                    .Range("C2").value = Trim(Right(c, 3))
                    .Range("G2").value = a
                    .Range("C4").value = "LGC"

                    Select Case b
                        Case "LGAS SHF", "SRC"
                            .Range("E4").value = "LGAS"
                        Case "LGPL SHF"
                            .Range("E4").value = "LGPL"
                        Case "FINANCE"
                            .Range("E4").value = "FIN PLC"
                     End Select

                    .Range("G4").value = "LGC"

                    Select Case b
                        Case "LGAS SHF", "LGPL SHF"
                            .Range("I4").value = "SHF"
                        Case "SRC"
                            .Range("I4").value = "SRC"
                        Case "FINANCE"
                            .Range("I4").value = "FIN_PLC"
                    End Select

                    ' -- SET VALUES ON TEMPLATE -- '

                    'update dropdowns of T.change tab
                    ws.Range("B1").value = a
                    ws.Range("B2").value = b
                    ws.Range("B3").value = c

                    Dim investmentReturn As Range
                    Dim capitalTransfer As Range
                    Dim cashSurplus As Range
                    Dim ifrsProfit As Range
                    Dim assets As Range

                    Set investmentReturn = ws.Range("C62:I62")
                    Set capitalTransfer = ws.Range("C64:I64")
                    Set cashSurplus = ws.Range("C65:I65")
                    Set ifrsProfit = ws.Range("C66:I66")
                    Set assets = ws.Range("C67:I72")

                    .Range("D17:J17").value = investmentReturn.value
                    .Range("D30:J30").value = capitalTransfer.value
                    .Range("D34:J34").value = cashSurplus.value
                    .Range("D46:J46").value = ifrsProfit.value
                    .Range("D52:J57").value = assets.value

                End With

                'save and close the template file
                template.SaveAs _
                Filename:=path & name & a & " - " & b & " - " & c & extension, _
                FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False

                iterations = iterations + 1
            Next c
        Next b
    Next a

template.Close

timeOff = Now - timeOn

MsgBox ("Successfully ran " & iterations & " iterations" & vbNewLine _
    & "Time: " & Format(timeOff, "hh:mm:ss"))

Application.ScreenUpdating = True
End Sub

Para maior clareza, esse snippet é essencial, pois altera os valores da minha planilha mestre para os valores que precisam ser inseridos em cada versão do modelo:

'update dropdowns of T.change tab
ws.Range("B1").value = a
ws.Range("B2").value = b
ws.Range("B3").value = c

Obrigado

    

Answer 1

Use isso antes de o código começar

 Application.ScreenUpdating = False
 Application.Calculation = xlCalculationManual

e use isso antes das sub extremidades

 Application.ScreenUpdating = True
 Application.Calculation = xlCalculationAutomatic

Sem ver o resto do seu código, não entendo bem por que você está atribuindo valores a intervalos codificados após o início dos ciclos. Eles mudariam todos os loops ... ou você está fazendo o loop através de pastas de trabalho / planilhas?

    

Answer 2

Você pode querer pular o VBA e tentar resolvê-lo com o Microsoft Power Query, como explicado em a resposta para essa questão do SU sobre mesclar tabelas do Excel.