Excel精英培训网

 找回密码
 注册
数据透视表40+个常用小技巧,让你一次学会!
12
返回列表 发新帖

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

[复制链接]
发表于 2017-1-11 14:46 | 显示全部楼层
如果是这样,问题不大。

9楼代码应该符合要求,但是我的做法更实用一点。

Combin_3.zip

79.17 KB, 下载次数: 9

excel精英培训的微信平台,每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程
回复

使用道具 举报

发表于 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.     ReDim cr(1 To k, 1 To 3) '定义存放输出结果的数组cr
  32.     For i = 1 To k '遍历字典记录结果数组br
  33.         If br(i, 1) > 1 Then '如果组合数>1则输出
  34.             i2 = i2 + 1 '输出行序号+1
  35.             For j = 1 To 3
  36.                 cr(i2, j) = br(i, j) '复制各行
  37.             Next
  38.         End If
  39.     Next
  40.    
  41.     [b5].CurrentRegion.Offset(1) = "" '清空输出区域
  42.     [b6].Resize(i2, 3) = cr '输出数组cr结果到工作表
  43.     [b6].Resize(i2, 3).Sort [b6], 1, [c6], , 1, [d6], 1, 2 '排序
  44.     MsgBox Format(Timer - tms, "0.000s ") & i2 '显示耗时 和 提取结果数
  45. End Sub
复制代码


评分

参与人数 2 +10 收起 理由
苏子龙 + 9 我和小伙伴都惊呆了
进击的投机君 + 1 很给力

查看全部评分

回复

使用道具 举报

发表于 2017-1-11 14:55 | 显示全部楼层
如果数据量大,我的算法肯定速度效率高一些。
回复

使用道具 举报

 楼主| 发表于 2017-1-11 15:28 | 显示全部楼层
香川群子 发表于 2017-1-11 14:55
如果数据量大,我的算法肯定速度效率高一些。

感谢老师,帮大忙了

请问如果我要进一步改进策略优化结果,对不止4个货币对进行统计,设为N个币种,要如何自动识别币种数量呢?是要用pagecount吗
回复

使用道具 举报

发表于 2017-1-11 21:20 | 显示全部楼层
进击的投机君 发表于 2017-1-11 15:28
感谢老师,帮大忙了

请问如果我要进一步改进策略优化结果,对不止4个货币对进行统计,设为N ...

根据你的CSV数据文件导入时自动处理。

如果你已经导入整理到1个工作簿文件了,那么用
Sheets.Count也可以。
回复

使用道具 举报

发表于 2017-1-13 09:57 | 显示全部楼层
学习学习!
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2024-3-29 18:29 , Processed in 3.902595 second(s), 15 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

快速回复 返回顶部 返回列表