[已解决]如何找出最佳组合

进击的投机君

求教各路大神，小弟的作业是通过6000多个策略对不同的4个货币对进行测试，每一行是每个策略算出的详细结果。

现在的问题是，如何找出同时满足几个条件的策略，并且该策略对不止一个货币对有效

举个例子，比如同时满足：

1.E列 Net profit>3000
2.F列 # of trade>800
3.G列 %wins >50%

我找出了
同时满足2个货币对：8个同时满足EURUSD和GBPUSD，5个同时满足GBPUSD和USDJPY, 7个满足USDJPY和USDCAD。
同时满足3个货币对 : 3个同时满足EURUSD,GBPUSD和USDJPY, 1个同时满足EURUSD,GBPUSD和USDCAD，2个GBPUSD，USDJPY和USDCAD
同时满足4个货币对 : 1个

那么，请问我如何通过条件筛选，把我要找的这些组合都列举找出来呢？ 比方说我要找同时满足3个货币对的策略，它就会分别列举出3个，1个和2个。筛选结果和图示见第二张附图

最佳答案

月排行榜 / 总排行榜

香川群子

2017-1-11 14:54

也是用了一个字典，代码注释一下：

1. Sub test() 'by kagawa 2017/1/11
   
2.     Dim ar1, ar2, br(), cr(), dic
   
3.     Dim c1, c2, c3, i&, i2&, j&, k&, m&, s$, t&, flg As Boolean, tms#
   
4.     tms = Timer
   
5.    
   
6.     c1 = [b1]: c2 = [b2]: c3 = [b3] '读取3个筛选条件参数
   
7.    
   
8.     Set dic = CreateObject("Scripting.Dictionary")
   
9.     m = Sheet1.[a2].End(4).Row
   
10.     ReDim br(1 To m, 1 To 3) '定义存放整理结果的数组br
    
11.    
    
12.     For j = 1 To 4 '遍历4个页面
    
13.         With Sheets(j)
    
14.             s = .Name '本页货币名称
    
15.             m = .[a2].End(4).Row '数据最大行数m
    
16.             ar1 = .[a1].Resize(m)  '读取第1列策略代码
    
17.             ar2 = .[e1].Resize(m, 3) '读取EFG这3列数据
    
18.         End With
    
19.         For i = 2 To m '遍历数据各行
    
20.             flg = False
    
21.             If ar2(i, 1) > c1 Then If ar2(i, 2) > c2 Then If ar2(i, 3) > c3 Then flg = True
    
22.             If flg Then '检查3项条件都符合时
    
23.                 t = dic(ar1(i, 1)) '查询本行策略代码在字典中的记录序号
    
24.                 If t = 0 Then k = k + 1: dic(ar1(i, 1)) = k: t = k: br(t, 3) = ar1(i, 1)
    
25.                 '如字典中尚无记录，则按顺序增加1行记录 写入策略代码
    
26.                 br(t, 1) = br(t, 1) + 1 '相同组合数统计+1
    
27.                 br(t, 2) = br(t, 2) & "," & s '增加相同组合对应的货币名称
    
28.             End If
    
29.         Next
    
30.     Next
    
31. 
    
32.     ReDim cr(1 To k, 1 To 3) '定义存放输出结果的数组cr
    
33.     For i = 1 To k '遍历字典记录结果数组br
    
34.         If br(i, 1) > 1 Then '如果组合数>1则输出
    
35.             i2 = i2 + 1 '输出行序号+1
    
36.             For j = 1 To 3
    
37.                 cr(i2, j) = br(i, j) '复制各行
    
38.             Next
    
39.         End If
    
40.     Next
    
41.    
    
42.     [b5].CurrentRegion.Offset(1) = "" '清空输出区域
    
43.     [b6].Resize(i2, 3) = cr '输出数组cr结果到工作表
    
44.     [b6].Resize(i2, 3).Sort [b6], 1, [c6], , 1, [d6], 1, 2 '排序
    
45.     MsgBox Format(Timer - tms, "0.000s ") & i2 '显示耗时 和 提取结果数
    
46. End Sub
    

复制代码

跳转到最佳答案楼层

hupin6331

M2公式=IF($E2>3000,IF($F2>800,IF($G2>50,"符合",""),""),"")下拉

进击的投机君

hupin6331 发表于 2017-1-10 15:18
M2公式=IF($E2>3000,IF($F2>800,IF($G2>50,"符合",""),""),"")下拉

这个是 EURUSD这一页的，一共有4个货币对4页呢

hupin6331

进击的投机君 发表于 2017-1-10 15:26
这个是 EURUSD这一页的，一共有4个货币对4页呢

不理解，上传附件看看

进击的投机君

我原文件每个币种有6000多个策略结果，9MB太大了。删了很多，只留下40行每页。

香川群子

解题思路：

一、首先提取各个币种满足3条件的策略编号，放入4个字典。
二、然后分别进行取2、取3、取4组合。用字典法即可排除得到结果。

香川群子

问一下楼主，货币属性是看页面标签、还是看C列属性？

因为附件中C列属性的货币和页面标签有些是不同的。


其次，问一下，是否每个页面的策略代码完全相同？
即是否A列都具有相同个数的策略代码，或者说A列（排序以后）完全相同？


这个对代码处理思路有影响。

进击的投机君

香川群子 发表于 2017-1-11 10:42
问一下楼主，货币属性是看页面标签、还是看C列属性？

因为附件中C列属性的货币和页面标签有些是不同的。 ...

老师你好，

是看标签为准。当然c列跟标签也是完全对应的。
每个页面的策略代码都相同，因为是同样的一组策略去回测4个不同的币种，所以也是同一个策略是测试了4个币种。

grf1973

1. Sub 组合()
   
2.     Dim sh As Worksheet
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     For i = 1 To 4
   
5.         arr = Sheets(i).[a1].CurrentRegion
   
6.         x = Sheets(i).Name
   
7.         For k = 2 To UBound(arr)
   
8.             If arr(k, 5) > 3000 And arr(k, 6) > 800 And arr(k, 7) > 50 Then d(arr(k, 1)) = d(arr(k, 1)) & "、" & x
   
9.         Next
   
10.     Next
    
11.    
    
12.     For Each x In d.keys
    
13.         xrr = Split(d(x), "、"): k = UBound(xrr)   'k为货币对的个数
    
14.         If k >= 2 Then
    
15.             r = Cells(65536, 2 * k - 3).End(3).Row + 1
    
16.             Cells(r, 2 * k - 3) = x
    
17.             Cells(r, 2 * k - 2) = Mid(d(x), 2)
    
18.         End If
    
19.     Next
    
20. End Sub
    

复制代码

进击的投机君

不好意思哈，文件数据排错了，现在改过来了