excel 如何改进蒙特卡罗模拟的VBA代码？

yeotifhr 于 2023-01-14 发布在其他

关注(0)|答案(1)|浏览(149)

我写了一个代码来把蒙特-卡罗模拟的结果存储在一个工作表中。这个宏所做的基本上是在每次迭代后把B6：DS6的值存储在模拟输出（1）工作表中的一个数组中，并把它们最后写在第6行下面。
我不是VBA方面的Maven，但我注意到计算仍然需要相当长的时间，例如10.000次迭代需要15分钟。此外，当我尝试运行超过5.000次模拟时，我经常会收到以下错误或消息。
Error Message 1或Error Message 2
任何关于错误的帮助和如何使代码更快的想法将不胜感激！提前感谢！奥斯卡

Sub MC_Sim()

'Varianblendeklaration
Dim Arr
Dim Outp
Dim i As Integer
Dim StartTime As Double
Dim SecondsElapsed As Double
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 setzen
Sheets("Annahmen").Select
    Range("F41").Select
    Range("F41").Value = "Monte Carlo Simulation"

'Löschen vorhandener Werte in Outputsheet
Sheets("Simulation Output (1)").Select
    Range("B7:DS7").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.ClearContents
    

'Kopieren und Output der Simulationswerte in Schleife über ein Array als Zwischenpspeicher
ReDim Outp(1 To Range("C1").Value, 1 To Range("B6:DS6").Columns.Count)

    For i = 1 To Range("C1")
        Arr = Range("B6:DS6").Value
        For S = 1 To UBound(Arr, 2)
           Outp(i, S) = Arr(1, S)
    Next
    
'Neuberechnung der Planzufallswerte in B6:DS6
Calculate
            
'Ausgabe Stausbar
SecondsElapsed = Round(Timer - StartTime, 2)
Application.StatusBar = "Simulation aktiv... I Fortschritt: " & i - 1 & " von " & Range("C1") & " Iterationen (" _
& Format((i - 1) / Range("C1"), "0%") & ") I Rechenzeit (Min:Sek): " & Format(SecondsElapsed / 60 / 60 / 24, "nn:ss")
    
Next
        
'Zurückschreiben der Werte aus dem Array in das Tabellenblatt
Range("B7").Resize(UBound(Outp, 1), UBound(Outp, 2)) = Outp

'Simulationszeit in Sekunden
Sheets("Simulation Output (1)").Select
    Range("C2").Value = SecondsElapsed

'Szenario zurück 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

'Hinweis
MsgBox "Ende der Simulation! Rechenzeit (Min:Sek): " & Format(SecondsElapsed / 60 / 60 / 24, "nn:ss")

'Funktionen An
Application.ScreenUpdating = True
Application.EnableEvents = True
Sheets("Simulation Output (2)").EnableCalculation = True
Sheets("Grafiken").EnableCalculation = True

'Zurücksetzen der Statusleiste und Löschen des Clipboards
Application.StatusBar = False
Application.CutCopyMode = False

End Sub

参见上面的代码，但是代码仍然很慢，对于更高的迭代，我会收到错误消息。

excel

来源：https://stackoverflow.com/questions/75051647/how-to-improve-vba-code-for-monte-carlo-simulation

1条答案

按热度按时间

xmq68pz91#

这对我很有效：给予看！

Option Explicit
Sub MC_Sim()
    
    'Varianblendeklaration
    Dim Arr
    Dim Outp
    Dim I As Long
    Dim S As Long
    Dim Lrow As Long
    Dim Xval As Long
    Dim StartTime As Double
    Dim SecondsElapsed As Double
    Dim MyTimer As Double
    
    'Funktionen Aus
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    
    'Timer für Simulationszeit
    StartTime = Timer
    
    'Szenario auf Monte Carlo Simulation setzen
    Sheets("Annahmen").Range("F41").Value = "Monte Carlo Simulation"

    'Löschen vorhandener Werte in Outputsheet
    With Sheets("Simulation Output (1)")
        Lrow = .Range("B7").End(xlDown).Row
        .Range("B7:DS" & Lrow).ClearContents
            
        'Kopieren und Output der Simulationswerte in Schleife über ein Array als Zwischenpspeicher
        Xval = .Range("C1").Value
        ReDim Outp(1 To Xval, 1 To .Range("B6:DS6").Columns.Count)
        
        For I = 1 To Xval
            Arr = .Range("B6:DS6")
            For S = 1 To UBound(Arr, 2)
               Outp(I, S) = Arr(1, S)
            Next S
                
            'Neuberechnung der Planzufallswerte in B6:DS6
            Calculate
                        
            'Ausgabe Stausbar
            SecondsElapsed = Round(Timer - StartTime, 2)
            Application.StatusBar = "Simulation aktiv... I Fortschritt: " & I - 1 & " von " & Xval & " Iterationen (" _
            & Format((I - 1) / Xval, "0%") & ") I Rechenzeit (Min:Sek): " & Format(SecondsElapsed / 60 / 60 / 24, "nn:ss")
                
        Next I
                
        'Zurückschreiben der Werte aus dem Array in das Tabellenblatt
        .Range("B7").Resize(UBound(Outp, 1), UBound(Outp, 2)) = Outp
        
        'Simulationszeit in Sekunden
        .Range("C2").Value = SecondsElapsed
        
        'Szenario zurück auf Base Case
        Sheets("Annahmen").Range("F41").Value = "Base Case"
        
        'Simulationszeit in Sekunden
        SecondsElapsed = Round(Timer - StartTime, 2)
        .Range("C2").Value = SecondsElapsed
        
        'Hinweis
        MsgBox "Ende der Simulation! Rechenzeit (Min:Sek): " & Format(SecondsElapsed / 60 / 60 / 24, "nn:ss")
        
    End With
    
    'Funktionen An
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    
    'Zurücksetzen der Statusleiste und Löschen des Clipboards
    Application.StatusBar = False
    Application.CutCopyMode = False

End Sub

赞(0）回复(0）举报 2023-01-14

我来回答

excel 如何改进蒙特卡罗模拟的VBA代码？

1条答案

相关问题

热门标签

最新问答