Question

我自动进行蒙特卡洛模拟的股票和期权价格，在606个交易日内运行1万条路径。所有这一切都很好，问题是这很慢。代码的缓慢部分是它必须将400 x 10000的数组写入电子表格，然后将其导出到新的CSV文件并保存。

它为25个选项组合执行此操作（每个选项需要1分钟。）因此整体需要25分钟，这是不可接受的。如何直接向CSV写入我正在填充模拟的数据数组？我需要保留所有股票价格，期权价格和总投资组合价值。下面是我为此创建的代码。

    Sub Background_simulation()

0   Application.ScreenUpdating = False
1   Windows("Option Portfolio Simulation v7.xlsm").Activate
2   Sheets("Export").Activate
3   Dim Arr() As Variant
4   ArrStock = Range("F11:NTU616")
6   ArrOption = Range("F621:NTU1226")
7   Sheets("Export").Activate

8   Dim DestinationStock As Range
9   Set DestinationStock = Range("F11")

10  Dim DestinationOption As Range
11  Set DestinationOption = Range("F621")
12  Dim RAND(1 To 606, 1 To 10000) As Variant
13  Paths = Range("D6").Value

15  Dim Option_Paths(1 To 606, 1 To 10000) As Variant
16  Dim St_Paths(1 To 606, 1 To 10000) As Variant
17  Dim Options_Total(1 To 606, 1 To 10000) As Variant
18  FromOption = Range("D7").Value
19  UpToOption = Range("D8").Value
20  Sheets("Portfolio").Select
21  Let MaxExpirationOfSet = Application.WorksheetFunction.Max(Range("BC2:BC26").Value)
22  Sheets("Export").Select

23  For a = 2 To 606
24  For b = 1 To Paths
25  Randomize
26  RAND(a, b) = Application.WorksheetFunction.NormInv(RND(), 0, 1)
27  Next
28  Next

31  For Option_Nr = FromOption To UpToOption
32  Sheets("Export").Select
33  Range("F11:NTU616").Select
34  Selection.ClearContents
35  Range("F621:NTU1226").Select
36  Selection.ClearContents
38  Range("B1").Select
39  ActiveCell.FormulaR1C1 = Option_Nr
42  Calls = Range("L3").Value
43  If Calls = 0 Then GoTo 2010
44  St = Range("G2").Value
45  Rf = Range("G3").Value
46  Sigma = Range("G4").Value
47  dt = 1 / 250
48  mrn = Rf - (1 / 2) * Sigma ^ 2
49  X = Range("L5").Value
50  Expiration_Date = Range("D4").Value

120 For b = 1 To Paths
130 RAND(1, b) = 1
140 St_Paths(1, b) = St
150 Option_Paths(1, b) = Application.WorksheetFunction.Max(St - X, 0) * Calls
160 Options_Total(1, b) = Options_Total(1, b) + Option_Paths(1, b)
170 Next

190  For a = 2 To Expiration_Date
200  For b = 1 To Paths
600  St_Paths(a, b) = St_Paths(a - 1, b) * Exp(mrn * dt + Sigma * (dt) ^ (1 / 2) * RAND(a, b))
700  Option_Paths(a, b) = Application.WorksheetFunction.Max(St_Paths(a, b) - X, 0) * Calls
701  Options_Total(a, b) = Options_Total(a, b) + Option_Paths(a, b)
703  Next
704  Next

705  For a = (Expiration_Date + 1) To MaxExpirationOfSet
706  For b = 1 To Paths
707  St_Paths(a, b) = St_Paths(a - 1, b)
710  Option_Paths(a, b) = Option_Paths(a - 1, b)
711  Options_Total(a, b) = Options_Total(a - 1, b)
712  Next
730  Next

740 Sheets("Export").Select
750 Range("F11:NTU616").Select
760 Selection.ClearContents
770 Range("F621:NTU1226").Select
780 Selection.ClearContents
790 Range("A1").Select

800 DestinationStock.Resize(UBound(ArrStock, 1), UBound(ArrStock, 2)).Value = St_Paths
810 DestinationOption.Resize(UBound(ArrOption, 1), UBound(ArrOption, 2)).Value = Option_Paths

830 Sheets("Export").Copy
840 Range("F620").Select
845 ActiveWorkbook.BreakLink Name:= _
        "C:\Users\pmesples\Desktop\Options\Option Portfolio Simulation v7.xlsm", Type _
        :=xlExcelLinks

850 ChDir "C:\Users\pmesples\Desktop\Options"
860 ActiveWorkbook.SaveAs Filename:="C:\Users\pmesples\Desktop\Options\" & Option_Nr & ".csv", _
        FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False


900  ActiveWindow.Close
1000 Sheets("Export").Select

1001 Range("F" & 620 + MaxExpirationOfSet & ":NTU" & 620 + MaxExpirationOfSet).Select
1002 Selection.Copy
1003 Sheets("Results").Select
1004 Cells(5, Option_Nr + 3).Select
1005 Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True

1006 Sheets("Export").Select
1010 Range("F11").Select
1020 Range(Selection, Selection.End(xlToRight)).Select
1030 Range(Selection, Selection.End(xlDown)).Select
1040 Selection.ClearContents
1050 Selection.End(xlDown).Select
1060 Range("F621").Select
1080 Range(Selection, Selection.End(xlDown)).Select
1090 Range(Selection, Selection.End(xlToRight)).Select
2000 Selection.ClearContents
2005 Range("A1").Select
2010 Next

2015 Range("B1").Select
2016 ActiveCell.FormulaR1C1 = 26
2020 DestinationOption.Resize(UBound(ArrOption, 1), UBound(ArrOption, 2)).Value = Options_Total
2030 Sheets("Export").Copy
2040 Range("F620").Select
2045 ActiveWorkbook.BreakLink Name:= _
        "C:\Users\pmesples\Desktop\Options\Option Portfolio Simulation v7.xlsm", Type _
        :=xlExcelLinks

2050 ChDir "C:\Users\pmesples\Desktop\Options"
2060 ActiveWorkbook.SaveAs Filename:="C:\Users\pmesples\Desktop\Options\26.csv", _
        FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False


2100  ActiveWindow.Close
2110 Sheets("Export").Select
2215 Range("B1").Select
2120 ActiveCell.FormulaR1C1 = 1


End Sub

Answer 1

您可能可以摆脱选择和选择以加速宏，例如：

32  Sheets("Export").Select
33  Range("F11:NTU616").Select
34  Selection.ClearContents

可以替换为

32  Sheets("Export").Range("F11:NTU616").ClearContents

但是你可能在保存文件时丢失了大部分宝贵的秒数，正如你已经注意到的那样。实际上，您可以尝试导出到文件，请参阅我的子例程：

Private Sub PrintToCSV(sFileName As String, rng As Range)
Dim TextFile As Integer
Dim FilePath As String
Dim FileContent As String
Dim cl As Range

FilePath = ThisWorkbook.Path & "\something something\" & sFileName & ".csv"

TextFile = FreeFile

Open FilePath For Output As TextFile

For Each cl In rng
    Print #TextFile, cl.Value
Next cl

Close TextFile
End Sub

但是，一般来说，VBA是脚本语言，所以它很慢。我不确定写入文件是否比保存更快，但你可以试试。

将数组发送到csv文件 - 模拟太慢

1 个答案: