请问怎么用VBA算最大回撤

guguzhang

cheetahfly 发表于 2014-11-18 13:07
楼主 所提的是一个金融投资方面的问题，用一般的excel计算方法去解答可能不全面，推荐http://zhiqiang.org/ ...

好文章,学习了

dashijieli

8楼 @qy1219no2，你好，你的代码有一个bug：如果行情一直上涨 最大回撤应该是0 但这代码返回的值是正数。。

d11yushi

楼主你好，已经帮你编了一个自定义函数，代码如下：

1. Function MaxDrawdown(InvestReturn) As Double    Dim max As Double, mdd As Double
   
2.     Dim InvestArr(), MaxArr(), MinArr(), Temp(), Drawdown(), Drawdown2D()
   
3.     Dim i As Long, j As Long, k As Long, BM As Long, l As Long, i1 As Long, x As Long, y As Long
   
4.     Dim step%
   
5. '    Dim Peak As String, Through As String, MDDvalue As String
   
6. '    Peak = "M3"
   
7. '    Through = "M4"
   
8. '    MDDvalue = "M5"
   
9. 
   
10.     InvestArr = Range2Arr(InvestReturn)
    
11.     j = 1
    
12.     k = 0
    
13.     step = 1
    
14. 
    
15.     ReDim Preserve MaxArr(1 To 2, 1 To 1)
    
16.     MaxArr(1, 1) = InvestArr(1)
    
17.     MaxArr(2, 1) = 1
    
18. 
    
19.     For i = 2 To UBound(InvestArr) - 1
    
20.         If InvestArr(i + step) <= InvestArr(i) And InvestArr(i - step) <= InvestArr(i) Then
    
21.             j = j + 1
    
22.             ReDim Preserve MaxArr(1 To 2, 1 To j)
    
23.             MaxArr(1, j) = InvestArr(i)
    
24.             MaxArr(2, j) = i
    
25.         End If
    
26.         If InvestArr(i) <= InvestArr(i + step) And InvestArr(i) <= InvestArr(i - step) Then
    
27.             k = k + 1
    
28.             ReDim Preserve MinArr(1 To 2, 1 To k)
    
29.             MinArr(1, k) = InvestArr(i)
    
30.             MinArr(2, k) = i
    
31.         End If
    
32.     Next i
    
33. 
    
34.     ReDim Preserve MinArr(1 To 2, 1 To k + 1)
    
35.     MinArr(1, k + 1) = InvestArr(i)
    
36.     MinArr(2, k + 1) = i
    
37. 
    
38.     Temp = MaxArr
    
39.     ReDim MaxArr(1 To j, 1 To 2)
    
40.     MaxArr = Application.WorksheetFunction.Transpose(Temp)
    
41.     Temp = MinArr
    
42.     ReDim MinArr(1 To k, 1 To 2)
    
43.     MinArr = Application.WorksheetFunction.Transpose(Temp)
    
44. 
    
45.     ReDim Drawdown(1 To UBound(MaxArr), 1 To UBound(MinArr), 1 To 3)
    
46. 
    
47.     For i1 = 1 To j
    
48.         BM = BenchMark(MinArr, MaxArr(i1, 2)) '获取样本序列中MaxArr(i1,1)之后的波谷横坐标
    
49.         For l = BM To k + 1
    
50.             Drawdown(i1, l, 1) = (MaxArr(i1, 1) - MinArr(l, 1)) / MaxArr(i1, 1) '获取最大回撤
    
51.             Drawdown(i1, l, 2) = MaxArr(i1, 2)                                  '获取波峰的横坐标
    
52.             Drawdown(i1, l, 3) = MinArr(l, 2)                                   '获取波谷的横坐标
    
53.         Next l
    
54.     Next i1
    
55. 
    
56.     ReDim Drawdown2D(1 To UBound(Drawdown, 1), 1 To UBound(Drawdown, 2))
    
57.     For i = 1 To UBound(Drawdown, 1)
    
58.         For j = 1 To UBound(Drawdown, 2)
    
59.             Drawdown2D(i, j) = Drawdown(i, j, 1)
    
60.         Next j
    
61.     Next i
    
62. 
    
63.     mdd = Application.WorksheetFunction.max(Drawdown2D)
    
64. 
    
65. '    ReDim Temp(1 To 2)
    
66. '    Temp = SearchCoordinates(mdd, Drawdown2D)
    
67. '    x = Drawdown(Temp(1), Temp(2), 2)
    
68. '    y = Drawdown(Temp(1), Temp(2), 3)
    
69. '    MsgBox "最大回撤的两个坐标分别是：" & x & "和" & y & "。"
    
70. '    Range(Peak).Value = x
    
71. '    Range(Through).Value = y
    
72. '    Range(MDDvalue).Value = mdd
    
73.     MaxDrawdown = mdd
    
74. 
    
75. End Function
    
76. Function Range2Arr(Range1) As Variant
    
77.     Dim arr()
    
78.     Dim i As Long, n As Long
    
79. 
    
80.     n = Range1.Rows.Count
    
81.     ReDim arr(1 To n)
    
82.     For i = 1 To n
    
83.         arr(i) = Range1(i)
    
84.     Next i
    
85.     Range2Arr = arr
    
86. End Function
    
87. Function BenchMark(arr, bm0) As Long
    
88.     Dim i As Long
    
89.     For i = 1 To UBound(arr)
    
90.         If arr(i, 2) > bm0 Then
    
91.             Exit For
    
92.         End If
    
93.     Next i
    
94.     BenchMark = i
    
95. End Function
    
96. Function MaxDrawdown2(InvestReturn) As Double
    
97.     Dim max As Double, mdd As Double
    
98.     Dim InvestArr(), MaxArr(), MinArr(), Temp(), Drawdown(), Drawdown2D()
    
99.     Dim i As Long, j As Long, k As Long, BM As Long, l As Long, i1 As Long, x As Long, y As Long
    
100.     Dim step%
     
101.     Dim Peak As String, Through As String, MDDvalue As String
     
102.     Peak = "M3"
     
103.     Through = "M4"
     
104.     MDDvalue = "M5"
     
105. 
     
106.     InvestArr = InvestReturn
     
107.     j = 1
     
108.     k = 0
     
109.     step = 1
     
110. 
     
111.     ReDim Preserve MaxArr(1 To 2, 1 To 1)
     
112.     MaxArr(1, 1) = InvestArr(1, 1)
     
113.     MaxArr(2, 1) = 1
     
114. 
     
115.     For i = 2 To UBound(InvestArr) - 1
     
116.         If InvestArr(i + step, 1) <= InvestArr(i, 1) And InvestArr(i - step, 1) <= InvestArr(i, 1) Then
     
117.             j = j + 1
     
118.             ReDim Preserve MaxArr(1 To 2, 1 To j)
     
119.             MaxArr(1, j) = InvestArr(i, 1)
     
120.             MaxArr(2, j) = i
     
121.         End If
     
122.         If InvestArr(i, 1) <= InvestArr(i + step, 1) And InvestArr(i, 1) <= InvestArr(i - step, 1) Then
     
123.             k = k + 1
     
124.             ReDim Preserve MinArr(1 To 2, 1 To k)
     
125.             MinArr(1, k) = InvestArr(i, 1)
     
126.             MinArr(2, k) = i
     
127.         End If
     
128.     Next i
     
129. 
     
130.     ReDim Preserve MinArr(1 To 2, 1 To k + 1)
     
131.     MinArr(1, k + 1) = InvestArr(i, 1)
     
132.     MinArr(2, k + 1) = i
     
133. 
     
134.     Temp = MaxArr
     
135.     ReDim MaxArr(1 To j, 1 To 2)
     
136.     MaxArr = Application.WorksheetFunction.Transpose(Temp)
     
137.     Temp = MinArr
     
138.     ReDim MinArr(1 To k, 1 To 2)
     
139.     MinArr = Application.WorksheetFunction.Transpose(Temp)
     
140. 
     
141.     ReDim Drawdown(1 To UBound(MaxArr), 1 To UBound(MinArr), 1 To 3)
     
142. 
     
143.     For i1 = 1 To j
     
144.         BM = BenchMark(MinArr, MaxArr(i1, 2)) '获取样本序列中MaxArr(i1,1)之后的波谷横坐标
     
145.         For l = BM To k + 1
     
146.             Drawdown(i1, l, 1) = (MaxArr(i1, 1) - MinArr(l, 1)) / MaxArr(i1, 1) '获取最大回撤
     
147.             Drawdown(i1, l, 2) = MaxArr(i1, 2)                                  '获取波峰的横坐标
     
148.             Drawdown(i1, l, 3) = MinArr(l, 2)                                   '获取波谷的横坐标
     
149.         Next l
     
150.     Next i1
     
151. 
     
152.     ReDim Drawdown2D(1 To UBound(Drawdown, 1), 1 To UBound(Drawdown, 2))
     
153.     For i = 1 To UBound(Drawdown, 1)
     
154.         For j = 1 To UBound(Drawdown, 2)
     
155.             Drawdown2D(i, j) = Drawdown(i, j, 1)
     
156.         Next j
     
157.     Next i
     
158. 
     
159.     mdd = Application.WorksheetFunction.max(Drawdown2D)
     
160. 
     
161.     ReDim Temp(1 To 2)
     
162.     Temp = SearchCoordinates(mdd, Drawdown2D)
     
163.     x = Drawdown(Temp(1), Temp(2), 2)
     
164.     y = Drawdown(Temp(1), Temp(2), 3)
     
165. '    MsgBox "最大回撤的两个坐标分别是：" & x & "和" & y & "。"
     
166.     Range(Peak).Value = x
     
167.     Range(Through).Value = y
     
168.     Range(MDDvalue).Value = mdd
     
169.     MaxDrawdown2 = mdd
     
170. 
     
171. End Function
     
172. Sub mdd()
     
173.     Dim Period As String, arr()
     
174.     Dim Peak As String, Through As String, MDDvalue As String
     
175.     Peak = "M3"
     
176.     Through = "M4"
     
177.     MDDvalue = "M5"
     
178.     Period = Range("M2").Value
     
179.     arr = Range(Period)
     
180. 
     
181.     Call MaxDrawdown2(arr)
     
182.     ActiveSheet.Shapes.AddChart2(227, xlLine).Select
     
183.     ActiveChart.SetSourceData Source:=Range(Period)
     
184.     ActiveChart.SetElement (msoElementDataLabelTop)
     
185. End Sub
     
186. Function SearchCoordinates(Goal As Double, arr) As Variant
     
187.     Dim i As Long, j As Long
     
188.     Dim brr(1 To 2)
     
189. '    ReDim SearchCoordinates(1 To 2)
     
190.     For i = 1 To UBound(arr, 1)
     
191.         For j = 1 To UBound(arr, 2)
     
192.             If arr(i, j) = Goal Then
     
193.                 GoTo 100
     
194.             End If
     
195.         Next j
     
196.     Next i
     
197.     MsgBox "未找到"
     
198.     Exit Function
     
199. 100:
     
200.     brr(1) = i
     
201.     brr(2) = j
     
202. 
     
203.     SearchCoordinates = brr
     
204. End Function

复制代码

此外，为楼主编了个宏，可以定位最大回撤波峰、波谷的坐标，并且绘制折线图，便于检验。详见附件。

望断红尘

d11yushi 发表于 2019-5-16 19:15
楼主你好，已经帮你编了一个自定义函数，代码如下：

太牛了老师，请问波峰波谷坐标是计算区间内最大回撤的坐标吗

whowen

d11yushi 发表于 2019-5-16 19:15
楼主你好，已经帮你编了一个自定义函数，代码如下：

您好，感谢分享代码，但是我测试后发现一个适用性问题，如果数据选择中有空值则无法返回运算结果，这个如何解决呢？

xingjinyu

d11yushi 发表于 2019-5-16 19:15
楼主你好，已经帮你编了一个自定义函数，代码如下：

请问各位，这位老师给的模板里面，MaxDrawdown2这个函数应该如何使用呢。