数组任意项求和

yiyiyicz

1. Sub tt31()
   
2. Dim arr, arr3, arr4, arr5, brr
   
3. Dim midVal
   
4. '**************************
   
5. '***每条记录可以反复出现***
   
6. '**************************
   
7. sh = 1
   
8. For n = 0 To 8 Step 3
   
9.     arr = Sheet1.Range("a1").Offset(0, n).Resize(10, 3).Value
   
10.     midVal = Application.WorksheetFunction.Sum(Sheet1.Range("a13").Offset(0, n).Resize(1, 3))
    
11.     pp = 2
    
12.     For k1 = 1 To 10
    
13.         For k2 = 1 To 10
    
14.             For k3 = 1 To 10
    
15.                 If arr(k1, 1) + arr(k2, 2) + arr(k3, 3) = midVal Then
    
16.                     Worksheets("sheet" & sh).Cells(pp, 1) = arr(k1, 1)
    
17.                     Worksheets("sheet" & sh).Cells(pp, 2) = arr(k2, 2)
    
18.                     Worksheets("sheet" & sh).Cells(pp, 3) = arr(k3, 3)
    
19.                     pp = pp + 1
    
20.                 End If
    
21.             Next
    
22.         Next
    
23.     Next
    
24. sh = sh + 1
    
25. Next
    
26. '**************************
    
27. '***每条记录只能出现一次***
    
28. '**************************
    
29. sh = 1
    
30. For n = 0 To 8 Step 3
    
31.     arr = Sheet1.Range("a1").Offset(0, n).Resize(10, 3).Value
    
32.     midVal = Application.WorksheetFunction.Sum(Sheet1.Range("a13").Offset(0, n).Resize(1, 3))
    
33.     pp = 2
    
34.     For k1 = 1 To 10
    
35.         For k2 = 1 To 10
    
36.             For k3 = 1 To 10
    
37.                 If arr(k1, 1) + arr(k2, 2) + arr(k3, 3) = midVal Then
    
38.                     Worksheets("sheet" & sh).Cells(pp, 5) = arr(k1, 1)
    
39.                     arr(k1, 1) = 0
    
40.                     Worksheets("sheet" & sh).Cells(pp, 6) = arr(k2, 2)
    
41.                     arr(k2, 2) = 0
    
42.                     Worksheets("sheet" & sh).Cells(pp, 7) = arr(k3, 3)
    
43.                     arr(k3, 3) = 0
    
44.                     pp = pp + 1
    
45.                 End If
    
46.             Next
    
47.         Next
    
48.     Next
    
49. sh = sh + 1
    
50. Next
    
51. End Sub
    

复制代码

win2009

看来只有sql有这个函数，请版主吧

yiyiyicz

win2009 发表于 2012-10-21 00:13
看来只有sql有这个函数，请版主吧

主要是运算时间
这个9数组合，只有将9个数全部算完才能知道这个组合与中值的差。而只有将所有的组合全部计算出来，才能知道哪十个组合与中值的差最小。这是最可靠的办法。
而这所有的组合是10亿个。这玩意算起来，起码要几个小时，闹不好要一天的时间。
用SQL的逻辑判断，大概也绕不过这样大量的计算

我也想知道，有没有更快的办法

yjliurong131

yiyiyicz老师，这个数据运行我这又有问题，能发给我一下这个组合的代码吗？还是按五列中每列任选一个数据，和最接近726就可以，谢谢了

yiyiyicz

yjliurong131 发表于 2012-10-21 13:47
yiyiyicz老师，这个数据运行我这又有问题，能发给我一下这个组合的代码吗？还是按五列中每列任选一个数据， ...

这个用5此嵌套循环就可以了（找出全部组合）
循环次数是10万次，时间可以接受

yjliurong131

yiyiyicz 发表于 2012-10-21 14:44
这个用5此嵌套循环就可以了（找出全部组合）
循环次数是10万次，时间可以接受

啊，偶菜鸟级别，实在是运行错误多多……，崩溃了要，麻烦老师指点代码

yiyiyicz

yjliurong131 发表于 2012-10-21 16:02
啊，偶菜鸟级别，实在是运行错误多多……，崩溃了要，麻烦老师指点代码

检查一下你的计算机系统，似乎有问题
要么有什么病毒一类的东西
要么你的office是正版的？还加上什么东西了？
为了防止别人下载后破坏自己的计算机系统
不要上传了，在当地找人看看吧
34楼只需要用最简单的方法就可以了，看35楼

抱歉
我在这里多次受到病毒等苦，不敢下载了

yjliurong131

yiyiyicz 发表于 2012-10-21 16:09
检查一下你的计算机系统，似乎有问题
要么有什么病毒一类的东西
要么你的office是正版的？还加上什么东 ...

谢谢，我自己也再想想，要是可以的话希望老师帮忙，五列数据如下
545.93        48.96        56.93        27.04        46.96
545.94        48.97        56.94        27.03        46.96
545.95        48.98        56.95        27.01        46.97
545.97        48.99        56.97        27.02        46.97
545.97        49        56.98        26.98        46.99
545.98        49.01        57.02        26.99        47.02
546.03        49.02        57.04        26.97        47.03
546.04        49.02        57.05        26.98        47.03
546.06        49.03        57.07        26.99        47.04
546.07        49.04        57.09        26.97        47.05

yiyiyicz

yjliurong131 发表于 2012-10-21 16:17
谢谢，我自己也再想想，要是可以的话希望老师帮忙，五列数据如下
545.93        48.96        56.93        27.04        46.96
545. ...

刚才我的系统好像因此出问题了
之前只是下载并打开你的附件

我估计，用简单的方法，加上你的处理，也不会超过2分钟

yiyiyicz

抱歉，等等别人出手吧
这里高手云集
不行的话，重新发帖。只需要把数据粘上就行