☰

代码迭代缓慢

tag-icon • tag-icon microsoft-excel vba
代码迭代缓慢

我有一个简单的宏，可以创建 16 个不同版本的模板，并通过从另一个打开的工作簿中获取值来更新。迭代 16 次需要一分钟多的时间，我想知道是否有办法加快速度？这会成为一个问题，因为我最终需要迭代 64 次以上。

我感觉我的代码运行缓慢的原因是因为我在循环中访问工作表太频繁了。我也考虑过减少字符串比较的次数，但似乎没有什么效果。

谢谢

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

为了清楚起见，此代码片段至关重要，因为它将主表上的值更改为需要输入到模板每个版本的值：

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

谢谢

答案1

在代码开始之前使用它

 Application.ScreenUpdating = False
 Application.Calculation = xlCalculationManual

在子目录结束前使用它

 Application.ScreenUpdating = True
 Application.Calculation = xlCalculationAutomatic

在没有看到代码的其余部分的情况下，我不太明白为什么在循环开始后要为硬编码范围分配值。它们会在每个循环中改变……还是您正在循环遍历工作簿/工作表？

答案2

您可能希望跳过 VBA 并尝试使用 Microsoft Power Query 解决它，正如我在SU 问题的答案关于合并 Excel 表。

相关内容