VBA Copy/Paste schneller MC-Simulation
08.01.2023 11:44:06
Oscar
für eine Monte Carlo Simulation habe ich ein kleines VBA programmiert welches mir die Ergebnisse von insgesamt 122 Berechnungsergebissen in eine Tabelle kopiert.
Der Code funktionert auch soweit, dauert nur relativ lange: bei 5.000 Iterationen ca. 15 Minuten und bei 10.000 Iterationen ca. 40 Minuten. (Prozessor: 11th Gen Intel(R) Core(TM) i5-1145G7 @ 2.60GHz 2.61 GHz; RAM: 32,0 GB).
Ich frage mich, ob es eine Möglichkeit gibt, den Code zu beschleunigen?
Für jegliche Unterstützung, den Code perfromanter zu machen, wäre ich sehr dankbar.
Vielen Dank vorab!
Oscar
Sub MC_Sim()
Dim StartTime As Double
Dim SecondsElapsed As Double
Dim loopNum As Integer
Dim outputRow As Integer
Dim outputColumn As Integer
Dim MyTimer As Double
'Funktionen Aus
Application.ScreenUpdating = False
Application.EnableEvents = False
Sheets("Simulation Output (2)").EnableCalculation = False
Sheets("Grafiken").EnableCalculation = False
'Timer für Simulationszeit
StartTime = Timer
'Szenario auf Monte Carlo Simulation
Sheets("Annahmen").Select
Range("F41").Select
Range("F41").Value = "Monte Carlo Simulation"
'Löschen vorhandener Werte
Sheets("Simulation Output (1)").Select
Range("B7:DS7").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
'Output der Simulationswerte in Schleife
outputRow = 7
outputColumn = 2
For loopNum = 1 To Range("C1")
Range("B6:DS6").Select
Application.CutCopyMode = False
Selection.Copy
Cells(outputRow + (loopNum - 1), outputColumn).Select
'Range("B7").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'Simulationszeit in Sekunden
Sheets("Simulation Output (1)").Select
SecondsElapsed = Round(Timer - StartTime, 2)
Range("C2").Value = SecondsElapsed
'Ausgabe Stausbar
Application.StatusBar = "Simulation aktiv... I Fortschritt: " & loopNum & " von " & Range("C1") & " Iterationen (" _
& Format(loopNum / Range("C1"), "0%") & ") I Rechenzeit (Min:Sek): " & Format(SecondsElapsed / 60 / 60 / 24, "nn:ss")
Next loopNum
'Szenario auf Base Case
Sheets("Annahmen").Select
Range("F41").Select
Range("F41").Value = "Base Case"
'Simulationszeit in Sekunden
Sheets("Simulation Output (1)").Select
SecondsElapsed = Round(Timer - StartTime, 2)
Range("C2").Value = SecondsElapsed
'Funktionen An
Application.ScreenUpdating = True
Application.EnableEvents = True
Sheets("Simulation Output (2)").EnableCalculation = True
Sheets("Grafiken").EnableCalculation = True
'Hinweis
MsgBox "Ende der Simulation! Rechenzeit (Min:Sek): " & Format(SecondsElapsed / 60 / 60 / 24, "nn:ss")
'Zurücksetzen der Statusleiste und Löschen des Clipboards
Application.StatusBar = False
Application.CutCopyMode = False
End Sub
