数组任意项求和

yjliurong131 · 发表于 2012-10-17 23:15

yiyiyicz 发表于 2012-10-17 23:00
好像不再需要组合了吧？
关键是充分利用排序的结果

水平有限，实在是不好参透，能指点一下代码吗？我也再想想

yiyiyicz · 发表于 2012-10-18 06:02

lipton 发表于 2012-10-17 22:34
http://club.excelhome.net/thread-688274-1-1.html

这是对账的问题，用在这里显得复杂了

yiyiyicz · 发表于 2012-10-18 06:14

本帖最后由 yiyiyicz 于 2012-10-18 06:16 编辑

yjliurong131 发表于 2012-10-17 23:15
水平有限，实在是不好参透，能指点一下代码吗？我也再想想

假如按照楼主条件，每列中只能选一个数字，且只能选一个
循环嵌套9次，运算次数最多是362880次。
也就是
for k1=1 to 10
for k2=k1 to 10
for k3=k2 to 10
......
for k9=k8 to 10

next k9,k8,...k1
中间加一些判断，跳出，运算次数就到不了362880次
这样算下来，时间应该能接受

yiyiyicz · 发表于 2012-10-18 06:23

只考虑偏差，是希望把循环嵌套的时间减下来
但是：
偏差有正有负。那么正数与负数之差，和最小偏差之和，这两者还需要比较
等下编个代码试一下
可能思路有问题

yjliurong131 · 发表于 2012-10-18 18:05

yiyiyicz 发表于 2012-10-18 06:23
只考虑偏差，是希望把循环嵌套的时间减下来
但是：
偏差有正有负。那么正数与负数之差，和最小偏差之和， ...

任意项求和，还是解决不了，~~~~(>_<)~~~~

yjliurong131 · 发表于 2012-10-18 18:35

朋友们我把完整问题描述一下，希望大侠们提供代码学习：
第一部分：第一列数据在404±0.25范围内，类似的，第二列212±0.15，第三列156±0.1，第四列-87±0.1，第五列36±0.05，第六列-95±0.1，第七列27±0.1，第八列26 ±0.05，第九列47±0.05。每列十个数据，每列任取一个数据相加得其和S1，
第二部分：第一列546±0.1，第二列49±0.05，第三列57±0.1，第四列27±0.05，第五列47±0.05，同样每列任取一个数据相加得其和S2，
最后，显示S1和S2差值最小的十种组合方式，谢谢各位了

yiyiyicz · 发表于 2012-10-18 21:18

Sub yy()
Dim arr, brr
arr = Range("a1:i12")
brr = Range("a1:i10")
For i = 1 To UBound(arr, 2)
For j = 1 To UBound(brr)
brr(j, i) = Round(arr(j, i) - arr(12, i), 2)
Next j
Next i
Sheet2.Range("a1").Resize(UBound(brr), UBound(arr, 2)) = brr
End Sub

复制代码

yiyiyicz · 发表于 2012-10-18 21:19

Sub tt()
Dim Prr(1 To 90, 1 To 2), Nrr(1 To 90, 1 To 2), Arr1, Arr2, brr
Dim C As Range, Rng As Range, pp As Integer, nn As Integer
Dim colStr As String, addstr As String
Set Rng = Range("a1:i10")
pp = 1
nn = 1
With Rng
For k = 1 To .Cells.Count
If .Cells(k) > 0 Then
Prr(pp, 1) = .Cells(k).Value
Prr(pp, 2) = .Cells(k).Address
pp = pp + 1
Else
Nrr(nn, 1) = .Cells(k).Value
Nrr(nn, 2) = .Cells(k).Address
nn = nn + 1
End If
Next k
End With
Range("k1").Resize(UBound(Prr), UBound(Prr, 2)) = Prr
Range("n1").Resize(UBound(Prr), UBound(Prr, 2)) = Nrr
Columns("K:L").Sort key1:=Range("K1"), order1:=xlAscending, header:=xlGuess
Columns("N:O").Sort key1:=Range("n1"), order1:=xlDescending, header:=xlGuess
colStr = "β"
addstr = "β"
obj = 13
Arr1 = Range("k1:l" & Range("k65536").End(xlUp).Row)
Arr2 = Range("n1:o" & Range("n65536").End(xlUp).Row)
For i = 1 To UBound(Arr1)
For j = 1 To UBound(Arr2)
If Arr1(i, 1) = Arr2(j, 1) * (-1) Then
If (Not InStr(1, colStr, Mid(Arr1(i, 2), 2, 1), 1) >= 1) And (Not InStr(1, addstr, Arr1(i, 2), 1)) _
And (Not InStr(1, colStr, Mid(Arr2(j, 2), 2, 1), 1) >= 1) And (Not InStr(1, addstr, Arr2(j, 2), 1)) _
And (Not Mid(Arr1(i, 2), 2, 1) = Mid(Arr2(j, 2), 2, 1)) Then
Range("b" & obj) = Sheet1.Range(Arr1(i, 2))
obj = obj + 1
Range("b" & obj) = Sheet1.Range(Arr2(j, 2))
obj = obj + 1
If obj >= 22 Then Exit Sub
colStr = colStr & Mid(Arr1(i, 2), 2, 1) & Mid(Arr2(j, 2), 2, 1)
addstr = addstr & Arr1(i, 2) & Arr2(j, 2)
GoTo line
End If
End If
Next j
line:
Next i
brr = Sheet1.Range("a1:i10")
For i = 1 To 9
If Not InStr(1, colStr, Mid(Sheet1.Cells(1, i).Address, 2, 1)) >= 1 Then
tem1 = Application.WorksheetFunction.Max(Application.WorksheetFunction.Index(brr, 0, i))
tem2 = Application.WorksheetFunction.Min(Application.WorksheetFunction.Index(brr, 0, i))
If tem1 - Sheet1.Cells(12, i) < Sheet1.Cells(12, i) Then
Range("b" & obj) = tem1
Else
Range("b" & obj) = tem2
End If
obj = obj + 1
If obj >= 22 Then Exit Sub
colStr = colStr & Mid(Sheet1.Cells(1, i).Address, 2, 1)
End If
Next
End Sub

复制代码

yiyiyicz · 发表于 2012-10-18 21:25

本帖最后由 yiyiyicz 于 2012-10-18 21:54 编辑

测试见附件
需要说明的是，这个代码的后面有凑数的问题
另外，此方法不是在所有的情况下都是正确的，指9个数据组合不一定是最靠近中值

我是现在才看到16楼的说明

yiyiyicz · 发表于 2012-10-18 21:29

本帖最后由 yiyiyicz 于 2012-10-18 21:34 编辑

yjliurong131 发表于 2012-10-18 18:35
朋友们我把完整问题描述一下，希望大侠们提供代码学习：
第一部分：第一列数据在404±0.25范围内，类似的， ...

这里的高手很多，相信会找到最佳解决方案
法师的那种方法，在对账中是有效的，但是要用到规划，太复杂
你的问题和对账不一样

另外，如果小数点位数加长，那么这种方法几乎无效
还是循环嵌套得出来的结果可靠，但是运行时间太长

既要准确，又要快，有难度

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

[求助] 数组任意项求和