数组任意项求和

yiyiyicz · 发表于 2012-10-19 10:54

Sub tt3()
Dim arr, brr, crr
Dim TurnId As Integer
Dim NumStr
arr = Sheet2.Range("a1:i10").Value
ReDim Preserve arr(1 To UBound(arr), 1 To UBound(arr, 2) * 2)
For i = 1 To UBound(arr)
For j = UBound(arr, 2) / 2 + 1 To UBound(arr, 2)
arr(i, j) = Sheet2.Cells(i, j - UBound(arr, 2) / 2).Address
Next j, i
ReDim brr(1 To 300, 0 To 2)
For TurnId = 0 To 2
pp = 1
For i = 1 + TurnId * 3 To 2 + TurnId * 3
For j = i + 1 To 3 + TurnId * 3
For k1 = 1 To UBound(arr)
For k2 = 1 To UBound(arr)
temp = arr(k1, i) + arr(k2, j)
temp1 = arr(k1, i + UBound(arr, 2) / 2) & "," & arr(k2, j + UBound(arr, 2) / 2)
If i + j = 3 + TurnId * 2 * 3 Then n = 3 + TurnId * 3
If i + j = 4 + TurnId * 2 * 3 Then n = 2 + TurnId * 3
If i + j = 5 + TurnId * 2 * 3 Then n = 1 + TurnId * 3
For ii = 1 To UBound(arr)
If arr(ii, n) + temp = 0 Then
brr(pp, TurnId) = temp1 & "," & arr(ii, n + UBound(arr, 2) / 2)
pp = pp + 1
End If
Next
Next
Next
Next
Next
Next TurnId
'Sheet3.Range("a1").Resize(300, 3) = brr
ReDim crr(1 To 300, 1 To 9)
pp = 1
For i = 0 To 2
For j = 1 To 300
If brr(j, i) = "" Then Exit For
NumStr = Split(brr(j, i), ",")
For k = 0 To 2
crr(j, i * 3 + k + 1) = Sheet1.Range(NumStr(k))
Next
Next
Next
Sheet3.Range("d1").Resize(300, 9) = crr
End Sub

复制代码

yiyiyicz · 发表于 2012-10-19 10:58

本帖最后由 yiyiyicz 于 2012-10-19 10:59 编辑

yjliurong131 发表于 2012-10-18 18:05
任意项求和，还是解决不了，~~~~(>_

测试，见附件
这段代码，应该可以满足你的要求了
三类数据，任意组合，都是中值726
但是，不能说在任何情况下都能得出满意的结果。但是附件的情况可以满足
特别是没有那么多组合为中值的情况下，需要增加偏差

求和并筛选数据.rar (18.1 KB, 下载次数: 14)

yjliurong131 · 发表于 2012-10-19 22:46

yiyiyicz 发表于 2012-10-19 10:58
测试，见附件
这段代码，应该可以满足你的要求了
三类数据，任意组合，都是中值726

学习需要，刚刚接触VBA，谢谢yiyiyicz老师指点！我运行了一下，筛选出的数据窜动是什么地方的问题？老师现在的解决方案是每列一个数据凑出726，若是按16楼我的描述，直接求两组数据差值最小是否不太容易呢？

yjliurong131 · 发表于 2012-10-19 23:00

yjliurong131 发表于 2012-10-19 22:46
学习需要，刚刚接触VBA，谢谢yiyiyicz老师指点！我运行了一下，筛选出的数据窜动是什么地方的问题？老师现 ...

仿照您前面的回答，我自己做了一下后四列的数据，也能得出组合结果，我的数据量不大（每列10个数据，两部分共十四列），运行时间长点也可以接受，主要是显示方式怎样更直观些，两部分的配合能一目了然？

yiyiyicz · 发表于 2012-10-20 06:45

本帖最后由 yiyiyicz 于 2012-10-20 08:37 编辑

yjliurong131 发表于 2012-10-19 22:46
学习需要，刚刚接触VBA，谢谢yiyiyicz老师指点！我运行了一下，筛选出的数据窜动是什么地方的问题？老师现 ...

“筛选出的数据窜动”，是什么意思？

求“两组数据差值最小”需要的时间太长
比如将所有可能组合与726比较，也就是差值。首先就是求出所有的组合
按照1楼的要求，这样的组合有 1,000,000,000 。也就是10亿个组合。按照楼主的要求，9个数只有全部加和后才能与726比较

按照附件的特定情况，只要找出组合的正负差为零的组合就能满足要求了。我想，如果附件代表实际情况，那么按照一般规律，这种方法在大多数情况下可以奏效。
对于凑三的方法，只要3个3列组合中，符合要求的3个数组合只要出现（2,2,3）就能凑出不止10个组合
而这种组合数是 3×1000=3000 比起10亿来，相差10万到1万倍之间
而你的附件中数据很容易就能做到这点。
假如还要进一步甄别怎么搭配3个3列组合，差值为零的组合数最多。则还需要做9选3的循环
即 COMBIN(9,3)=84
那么，要计算的组合数为 3×1000×84=252,000
如果这样，比起10亿个组合数计算起来，时间还差着100到1000倍，差着数量级
假如这种算法需要1分钟，那么找出所有组合最少也要100分钟。也就是1小时40分钟。
如果只是任意找3个3列组合，计算时间总共不超过2秒。如果变成1万倍，那也差不多要6个小时！

如果是工程计算，我想还是怎么省事怎么来

yiyiyicz · 发表于 2012-10-20 07:04

本帖最后由 yiyiyicz 于 2012-10-20 08:40 编辑

直观的显示方式并不难

可以用split( )函数将每个单元格地址分离出来
即 temp=split("$a$1,$b$1,$c$1",",")；temp(0)="$a$1"；temp(1)="$ab$1"；temp(2)="$c$1"；
将这三个单元格地址放进一个一维数组

当存放第二组的三个单元格地址时，先用filter( )检查一下这个一维数组中是不是已经有相同的单元格地址，或者相同的行（在10组组合中，每条记录只能出现一次）
具体就是检查filter检查结果的ubound()是否大于零，如果大于零，说明已经有相同的记录

最后，将这些单元格地址带入 sheet1.range()就得出了最初给定的具体数字了
注意，这些不同单元格地址对应的数字记录可能会相同。因为原来记录就有重复的

yjliurong131 · 发表于 2012-10-20 09:40

yiyiyicz 发表于 2012-10-20 07:04
直观的显示方式并不难

可以用split( )函数将每个单元格地址分离出来

窜行的问题我上传了图片，不知您那运行时有无此问题？

yjliurong131 · 发表于 2012-10-20 09:40

yiyiyicz 发表于 2012-10-20 07:04
直观的显示方式并不难

可以用split( )函数将每个单元格地址分离出来

窜行的问题我上传了图片，不知您那运行时有无此问题？

yjliurong131 · 发表于 2012-10-20 09:45

C:\Users\ASUS\Desktopyiyiyicz老师，还有一个问题，后三列得出的数据分组中，为什么不是每列都选出一个数据了？

yiyiyicz · 发表于 2012-10-20 14:31

本帖最后由 yiyiyicz 于 2012-10-20 14:33 编辑

测试，见附件

窜行的问题是由于循环方式造成的，没有错

楼上代码说明中“每条记录”是指对应单元格地址的记录，而不是数字相同

如果要求“每条记录只能出现一次”，那么简单的三三组合就不行了。需要把所有可能的三三组合全部计算一遍
但是，全部算一遍的时间也不会太长
当然，把所有可能的三三组合全部计算一遍，也不一定找出9个数组合在一起的10条记录
那时就要采取复杂的方法来计算了！

我没有写“把所有可能的三三组合全部计算”代码

		自动登录	找回密码
密码			免费注册

[求助] 数组任意项求和