【算法】【原創(chuàng)】計算總數(shù)是由哪些數(shù)之和

盜夢

摘要
總有一些財務(wù)的朋友，拿一些數(shù)據(jù)和一個總數(shù)問：這個總數(shù)是哪些數(shù)字之和。
每次我都忍不住要翻白眼。。。
（為什么不問提供這些數(shù)據(jù)的人員呢）

于是，就嘗試用代碼實現(xiàn)這個功能。

算法思路（源碼和附件在后面，不想看思路可以跳過）
假如，現(xiàn)在有一組數(shù)據(jù){1, 2, 3, 4, 5}和一個總數(shù)：6。
我想知道這個6可以是哪些數(shù)字之和。
用肉眼很明顯看出 6=2+4 ，6=1+5，6=1+2+3

那么這個就涉及到排列組合中的組合，因為加法交換律，不用考慮數(shù)字的前后順序。
但是，一個總數(shù)可能是一個數(shù)之和，也可能是兩個數(shù)之和。那么就需要判斷一個數(shù)之和到全部數(shù)之和的組合結(jié)果。
例如，
1個數(shù)組合：1，2，3，4，5
2個數(shù)組合：
   1+2，1+3，1+4，1+5
   2+3，2+4，2+5
   3+4，3+5
   4+5
3個數(shù)組合：
   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個數(shù)組合：
   1+2+3+4，1+2+3+5
   1+2+4+5
   1+3+4+5
   2+3+4+5
5個數(shù)組合：
   1+2+3+4+5

當然，這么多組合，不可能你一個一個羅列出來。那不得累死。。。
我上面來羅列的時候，是有規(guī)律的，不是隨便寫的。這個就涉及到我如何取數(shù)據(jù)組合的方法了
這種方法我稱之為“末尾移動法”。（不知道有沒重名，自己揣摩出來的）

例如，要在N個數(shù)中取m個數(shù)。
第1次取值，前m個數(shù)：N1,N2,...,N(m-1),N(m)
第2次取值，把最后的一個數(shù)，往前移動一位：N1,N2,...,N(m-1),N(m+1)
第3次取值，同樣最后一個數(shù)繼續(xù)往前移動：N1,N2,...,N(m-1),N(m+2)
...一直移到不能再移動，也就是最后一個數(shù)
第N-m+1次取值，N1,N2,...,N(m-1),N(N)

最后一個數(shù)移動完成之后，輪到倒數(shù)第二個數(shù)字移動取值。
第N-m+2次取值，N1,N2,...,N(m),N(N)
...同樣一直移到不能再移動為止，如下
第2N-2m+3次取值，N1,N2,...N(N-1),N(N)

接下來，剩下幾個數(shù)輪番處理，直到完成所有組合。
思路看起來有些復(fù)雜，沒辦法，算法就是這樣，哈哈哈

源碼

1. Option Explicit
   
2. 
   
3. '=============================================
   
4. '= 函數(shù)：計算總數(shù)是由哪些數(shù)之和
   
5. '= 作者：阿航
   
6. '= 參數(shù)：
   
7. '=   - arrValue()   數(shù)組     數(shù)據(jù)池
   
8. '=   - dblResult    雙精度   總數(shù)
   
9. '=   - dblFixed     雙精度   偏差值(誤差值)
   
10. '=============================================
    
11. Public Function GetCombo(arrValue(), dblResult As Double, Optional dblFixed As Double = 0)
    
12.     Dim arrSrc As Long              '元素個數(shù)上限
    
13.     Dim arrCalc()                   '計算
    
14.     Dim i As Long, iAll As Long     '循環(huán)因子
    
15.     Dim iCurrent As Long            '正在變換第幾個元素
    
16.     Dim dblSum As Double            '求和
    
17.     Dim strExp As String            '輸出表達式
    
18.     Dim dblCount As Double          '次數(shù)
    
19.    
    
20.     arrSrc = UBound(arrValue)
    
21.    
    
22.     '從1個元素求和到全部元素求和
    
23.     For iAll = 0 To arrSrc
    
24.         '設(shè)置幾項循環(huán)
    
25.         ReDim arrCalc(iAll)
    
26.         '初始化
    
27.         For i = LBound(arrCalc) To UBound(arrCalc)
    
28.             arrCalc(i) = i
    
29.         Next i
    
30.         
    
31.         dblCount = 0    '計數(shù)歸零
    
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 '計數(shù)累計
    
40.             
    
41.             '判斷求和是否正確
    
42.             If (dblSum + dblFixed >= dblResult) And (dblSum - dblFixed <= dblResult) Then   '設(shè)置偏差
    
43.                 '先輸出結(jié)果
    
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  '得到一次結(jié)果，就退出(可以不先退出，一直計算)
    
50.             End If
    
51. 
    
52.             '判斷當前循環(huán)數(shù)字
    
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.             '當前循環(huán)因子前進一格
    
64.             arrCalc(iCurrent) = arrCalc(iCurrent) + 1
    
65.             
    
66.             '重置后面的循環(huán)因子
    
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 & "項求和判斷，計算次數(shù)：" & dblCount
    
72.     Next iAll
    
73.     Debug.Print "Compelite"
    
74. End Function
    
75. 
    
76. '測試，在立即窗口輸入 gTest ，然后敲回車，即可看到測試結(jié)果
    
77. Public Function gTest()
    
78.     Dim arr()
    
79.     arr() = Array(921, 831, 639, 603, 596, 884)
    
80.     GetCombo arr, 2156
    
81. End Function

復(fù)制代碼

我們測試一下：總數(shù)為2156，數(shù)據(jù)池是{921，831，639，603，596，884}求2156是哪些數(shù)字之和。
在立即窗口輸入 gTest ，然后敲回車


我上面寫的函數(shù)可以設(shè)置誤差值，誤差值為10，可以再得到一個結(jié)果。

附件：

優(yōu)化建議：
如果你有更好的取組合方法，可以修改優(yōu)化看看。
另外，如果數(shù)據(jù)池比較多。可以嘗試先用快速排序法，降序排列。
每開始新的取n項組合之前，就判斷第一次之和是否大于等于總數(shù)。如果為假，則不用取n項組合了。

tmtony

強貼！

5988143

認真學(xué)習(xí)一下~收藏精品案例~

盜夢

Debug.Print Right(strExp, Len(strExp) - 1) & "=" & dblSum
打印結(jié)果這里,可以用 Join 方法合并數(shù)組的元素

做夢

lihai