【算法】【原创】计算总数是由哪些数之和

盗梦

摘要
总有一些财务的朋友，拿一些数据和一个总数问：这个总数是哪些数字之和。
每次我都忍不住要翻白眼。。。
（为什么不问提供这些数据的人员呢）

于是，就尝试用代码实现这个功能。

算法思路（源码和附件在后面，不想看思路可以跳过）
假如，现在有一组数据{1, 2, 3, 4, 5}和一个总数：6。
我想知道这个6可以是哪些数字之和。
用肉眼很明显看出 6=2+4 ，6=1+5，6=1+2+3

那么这个就涉及到排列组合中的组合，因为加法交换律，不用考虑数字的前后顺序。
但是，一个总数可能是一个数之和，也可能是两个数之和。那么就需要判断一个数之和到全部数之和的组合结果。
例如，
1个数组合：1，2，3，4，5
2个数组合：
   1+2，1+3，1+4，1+5
   2+3，2+4，2+5
   3+4，3+5
   4+5
3个数组合：
   1+2+3，1+2+4，1+2+5
   1+3+4，1+3+5
   1+4+5
   2+3+4，2+3+5
   2+4+5
   3+4+5
4个数组合：
   1+2+3+4，1+2+3+5
   1+2+4+5
   1+3+4+5
   2+3+4+5
5个数组合：
   1+2+3+4+5

当然，这么多组合，不可能你一个一个罗列出来。那不得累死。。。
我上面来罗列的时候，是有规律的，不是随便写的。这个就涉及到我如何取数据组合的方法了
这种方法我称之为“末尾移动法”。（不知道有没重名，自己揣摩出来的）

例如，要在N个数中取m个数。
第1次取值，前m个数：N1,N2,...,N(m-1),N(m)
第2次取值，把最后的一个数，往前移动一位：N1,N2,...,N(m-1),N(m+1)
第3次取值，同样最后一个数继续往前移动：N1,N2,...,N(m-1),N(m+2)
...一直移到不能再移动，也就是最后一个数
第N-m+1次取值，N1,N2,...,N(m-1),N(N)

最后一个数移动完成之后，轮到倒数第二个数字移动取值。
第N-m+2次取值，N1,N2,...,N(m),N(N)
...同样一直移到不能再移动为止，如下
第2N-2m+3次取值，N1,N2,...N(N-1),N(N)

接下来，剩下几个数轮番处理，直到完成所有组合。
思路看起来有些复杂，没办法，算法就是这样，哈哈哈

源码

1. Option Explicit
   
2. 
   
3. '=============================================
   
4. '= 函数：计算总数是由哪些数之和
   
5. '= 作者：阿航
   
6. '= 参数：
   
7. '=   - arrValue()   数组     数据池
   
8. '=   - dblResult    双精度   总数
   
9. '=   - dblFixed     双精度   偏差值(误差值)
   
10. '=============================================
    
11. Public Function GetCombo(arrValue(), dblResult As Double, Optional dblFixed As Double = 0)
    
12.     Dim arrSrc As Long              '元素个数上限
    
13.     Dim arrCalc()                   '计算
    
14.     Dim i As Long, iAll As Long     '循环因子
    
15.     Dim iCurrent As Long            '正在变换第几个元素
    
16.     Dim dblSum As Double            '求和
    
17.     Dim strExp As String            '输出表达式
    
18.     Dim dblCount As Double          '次数
    
19.    
    
20.     arrSrc = UBound(arrValue)
    
21.    
    
22.     '从1个元素求和到全部元素求和
    
23.     For iAll = 0 To arrSrc
    
24.         '设置几项循环
    
25.         ReDim arrCalc(iAll)
    
26.         '初始化
    
27.         For i = LBound(arrCalc) To UBound(arrCalc)
    
28.             arrCalc(i) = i
    
29.         Next i
    
30.         
    
31.         dblCount = 0    '计数归零
    
32.         
    
33.         Do
    
34.             '取值求和
    
35.             dblSum = 0
    
36.             For i = LBound(arrCalc) To UBound(arrCalc)
    
37.                 dblSum = dblSum + arrValue(arrCalc(i))
    
38.             Next i
    
39.             dblCount = dblCount + 1 '计数累计
    
40.             
    
41.             '判断求和是否正确
    
42.             If (dblSum + dblFixed >= dblResult) And (dblSum - dblFixed <= dblResult) Then   '设置偏差
    
43.                 '先输出结果
    
44.                 strExp = ""
    
45.                 For i = LBound(arrCalc) To UBound(arrCalc)
    
46.                     strExp = strExp & "+" & arrValue(arrCalc(i))
    
47.                 Next i
    
48.                 Debug.Print Right(strExp, Len(strExp) - 1) & "=" & dblSum
    
49.                 'Exit Function  '得到一次结果，就退出(可以不先退出，一直计算)
    
50.             End If
    
51. 
    
52.             '判断当前循环数字
    
53.             iCurrent = -1
    
54.             For i = UBound(arrCalc) To LBound(arrCalc) Step -1
    
55.                 If arrSrc = (UBound(arrCalc) - i) + arrCalc(i) Then
    
56.                 Else
    
57.                     iCurrent = i
    
58.                     Exit For
    
59.                 End If
    
60.             Next i
    
61.             If iCurrent = -1 Then Exit Do   '没有符合条件的，就是都到顶了
    
62. 
    
63.             '当前循环因子前进一格
    
64.             arrCalc(iCurrent) = arrCalc(iCurrent) + 1
    
65.             
    
66.             '重置后面的循环因子
    
67.             For i = iCurrent + 1 To UBound(arrCalc)
    
68.                 arrCalc(i) = arrCalc(i - 1) + 1
    
69.             Next i
    
70.         Loop
    
71.         Debug.Print "完成" & iAll + 1 & "项求和判断，计算次数：" & dblCount
    
72.     Next iAll
    
73.     Debug.Print "Compelite"
    
74. End Function
    
75. 
    
76. '测试，在立即窗口输入 gTest ，然后敲回车，即可看到测试结果
    
77. Public Function gTest()
    
78.     Dim arr()
    
79.     arr() = Array(921, 831, 639, 603, 596, 884)
    
80.     GetCombo arr, 2156
    
81. End Function

复制代码

我们测试一下：总数为2156，数据池是{921，831，639，603，596，884}求2156是哪些数字之和。
在立即窗口输入 gTest ，然后敲回车


我上面写的函数可以设置误差值，误差值为10，可以再得到一个结果。

附件：

优化建议：
如果你有更好的取组合方法，可以修改优化看看。
另外，如果数据池比较多。可以尝试先用快速排序法，降序排列。
每开始新的取n项组合之前，就判断第一次之和是否大于等于总数。如果为假，则不用取n项组合了。

tmtony

强贴！

5988143

認真學習一下~收藏精品案例~

盗梦

Debug.Print Right(strExp, Len(strExp) - 1) & "=" & dblSum
打印结果这里,可以用 Join 方法合并数组的元素

做梦

lihai