У меня есть простой макрос, который создает 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
Спасибо