[已解决]请求帮组写一段VBA有附件

yaxi520

请求帮组写一段VBA有附件

最佳答案

月排行榜 / 总排行榜

香川群子

2012-5-5 11:29

楼主附件数据 137期的计算结果。

1. Sub test()
   
2.     Dim i%, j%, k%, m%, n%, a%, b%, c%
   
3.    
   
4.     arr = Sheet2.[a1].CurrentRegion '获取表2各期数据
   
5.     m = UBound(arr) '最大行位置
   
6.    
   
7.     ReDim brr%(2 To m, 1 To 12) '整理各期原始数据到数组brr，便于高效计算比对
   
8.     For i = 2 To m
   
9.         For j = 1 To 5
   
10.             brr(i, arr(i, j)) = 1 '算法关键：把各期数据拆分放置到相应1-12列位置
    
11.         Next
    
12.     Next
    
13.    
    
14.     n = Application.Combin(12, 3) '计算12选3最大组合数
    
15.     ReDim crr(1 To n, 1 To 4) '定义存放结果的数组crr
    
16.    
    
17.     For a = 1 To 10
    
18.     For b = a + 1 To 11
    
19.     For c = b + 1 To 12
    
20.         k = k + 1 '高效获取12选3组合结果
    
21.         For i = 2 To m '遍历数组brr，比对已经按列整理好的各期数据。
    
22.             If brr(i, a) * brr(i, b) * brr(i, c) Then '如果含有该组合
    
23.                 crr(k, 1) = crr(k, 1) + 1 '【出现次数+1】
    
24.                 If crr(k, 4) > crr(k, 2) Then crr(k, 2) = crr(k, 4) '比对并储存【最大遗漏】
    
25.                 crr(k, 3) = crr(k, 4) '更新【上次遗漏】
    
26.                 crr(k, 4) = 0 '重置【最新未出】
    
27.             Else
    
28.                 crr(k, 4) = crr(k, 4) + 1 '【最新未出数+1】
    
29.             End If
    
30.         Next
    
31.     Next c, b, a
    
32.    
    
33.     Sheet1.[b2].Resize(n, 4) = crr '输出结果到工作表
    
34. End Sub
    

复制代码

我的算法 在这里 无人能匹敌。

跳转到最佳答案楼层

桀骜孤星

附件在哪呢，没有见呀

yaxi520

桀骜孤星 发表于 2012-5-5 08:07
附件在哪呢，没有见呀

附件刚刚没加上  谢谢提醒

桀骜孤星

彩票不适合数学，数学家也不会中奖

yaxi520

桀骜孤星 发表于 2012-5-5 09:00
彩票不适合数学，数学家也不会中奖

说的很有道理    谢谢你我会记住的   9分运气1分算计   我不想丢在这1分上   如果能的到老师的帮助还是不胜感激的

桀骜孤星

菜票就是  而已，哄人呀。我不是老师，我是幼儿园的

香川群子

楼主附件数据 137期的计算结果。

1. Sub test()
   
2.     Dim i%, j%, k%, m%, n%, a%, b%, c%
   
3.    
   
4.     arr = Sheet2.[a1].CurrentRegion '获取表2各期数据
   
5.     m = UBound(arr) '最大行位置
   
6.    
   
7.     ReDim brr%(2 To m, 1 To 12) '整理各期原始数据到数组brr，便于高效计算比对
   
8.     For i = 2 To m
   
9.         For j = 1 To 5
   
10.             brr(i, arr(i, j)) = 1 '算法关键：把各期数据拆分放置到相应1-12列位置
    
11.         Next
    
12.     Next
    
13.    
    
14.     n = Application.Combin(12, 3) '计算12选3最大组合数
    
15.     ReDim crr(1 To n, 1 To 4) '定义存放结果的数组crr
    
16.    
    
17.     For a = 1 To 10
    
18.     For b = a + 1 To 11
    
19.     For c = b + 1 To 12
    
20.         k = k + 1 '高效获取12选3组合结果
    
21.         For i = 2 To m '遍历数组brr，比对已经按列整理好的各期数据。
    
22.             If brr(i, a) * brr(i, b) * brr(i, c) Then '如果含有该组合
    
23.                 crr(k, 1) = crr(k, 1) + 1 '【出现次数+1】
    
24.                 If crr(k, 4) > crr(k, 2) Then crr(k, 2) = crr(k, 4) '比对并储存【最大遗漏】
    
25.                 crr(k, 3) = crr(k, 4) '更新【上次遗漏】
    
26.                 crr(k, 4) = 0 '重置【最新未出】
    
27.             Else
    
28.                 crr(k, 4) = crr(k, 4) + 1 '【最新未出数+1】
    
29.             End If
    
30.         Next
    
31.     Next c, b, a
    
32.    
    
33.     Sheet1.[b2].Resize(n, 4) = crr '输出结果到工作表
    
34. End Sub
    

复制代码

我的算法 在这里 无人能匹敌。

yaxi520

香川群子 发表于 2012-5-5 11:29
楼主附件数据 137期的计算结果。我的算法 在这里 无人能匹敌。

恩人。。名不需传