一个小excel宏:找出一组数中和为某个值的所有组合

朋友在账务分析时的一个需求，需要从excel的一列中找出和为某个值的所有组合，请我帮忙写一个。

我想，正好趁机会了解一下vba和excel宏的编写，就接下了这个小活，算法可能不一定最优，vba的代码可能也写的不专业(第1次写，见笑)，但是好歹实现了出来，也算是对vba有一定的了解了，达到了随便研究研究的目的:)

算法大概就是遍历这组数的所有组合，找到和为给定值的组合。n个数的所有组合有2^n-1种，复杂度成指数级，跟朋友了解了一下，元素的总数不超过50个，每个数是小数点最多2位，有可能有重复的数，其中一部分数大于给定的和

实现的想法是，对一个用n+1 bit（n为数组元素个数）存储的数，每个bit的位置对应数组中元素的位置，从0开始，不断+1.直到最高位为1时停止，此过程中每次+1得到的bit位对应的数据元素组合，汇总起来就是数组中所有元素的全部组合，对这些组合进行计算，和为给定值，就是一个解

能想到优化点：
1、把所有浮点数*100取整，再用于运算，避免过多浮点数预算
2、先把大于给定和的元素剔除掉，把和等于给定元素的直接输出，剩下的再进行组合
3、把数组从大到小排列，让和可能大于给定值的情况尽早暴漏，并终止计算（下面的代码没有把这个写进去，当时在加班，一忙就懒得写进去了，可以补进去）
4、把之前算过的和记录下来，后面再用到时直接使用（动态规划的思想，但是我用python先实践了一下，发现需要的内存太大了，跑一会就耗光了内存，于是放弃了个方法）

另外学到一点vba写excel宏的皮毛：
1、alt+F11切换到vba代码编辑器
2、获取选中的excel表格区域：ActiveWindow.RangeSelection
3、获取一个区域中某个单元格中的值：Cells(row, col)
4、创建一个新的sheet:Sheets.Add
5、根据变量设定数组大小的方式： 先定义一个未知大小的数组：Dim tmpArray() As Single 确定长度时，再重新定义大小：ReDim tmpArray(arrayLen - 1) As Single
6、vb的Integer是2字节表示的有符号数，对于大于32768的数不能正确表示，所以需要用Long来记录*100以后的数组元素
7、CLng函数把参数强制转成Long型数，CSng把参数强制转成浮点数

实现的代码如下：

Sub selectAll()
Dim tmpArray() As Single
Dim intArray() As Long
Dim arrayLen As Integer
Dim intArrayLen As Integer
Dim intSum As Long
Dim sumValue As Single
Dim i As Integer
Dim j As Integer
Dim k As Integer

With ActiveWindow.RangeSelection
arrayLen = .Columns.Count * .Rows.Count
ReDim tmpArray(arrayLen - 1) As Single
k = 0
For i = 1 To .Columns.Count
    For j = 1 To .Rows.Count
        tmpArray(k) = .Cells(j, i)
        k = k + 1
    Next j
Next i
End With

sumValue = InputBox("input sum:")
intSum = CLng(sumValue * 100)

With Sheets.Add
    Dim cellRow As Integer
    Dim cellCol As Integer
    cellRow = 1
    cellCol = 1

    k = 0
    intArrayLen = 0
    ReDim intArray(arrayLen - 1) As Long
    Dim tmpIntValue As Long
    For i = 0 To arrayLen - 1
        tmpIntValue = CLng(tmpArray(i) * 100)
        If tmpIntValue <= intSum Then
            intArray(k) = tmpIntValue
            k = k + 1
        End If
    Next i

    intArrayLen = k
    Dim bitArray() As Byte
    ReDim bitArray(intArrayLen) As Byte
    For i = 0 To intArrayLen
        bitArray(i) = 0
    Next i

    bitArray(0) = 1
    Dim tmpSum As Long
    Dim tmpResult() As Long
    ReDim tmpResult(intArrayLen) As Long
    Dim tmpResNum As Integer
    Dim flag As Integer
    Do While bitArray(intArrayLen) <> 1
        tmpSum = 0
        tmpResNum = 0
        For j = 0 To intArrayLen - 1
            If bitArray(j) = 1 Then
                tmpSum = tmpSum + intArray(j)
                If tmpSum > intSum Then
                    Exit For
                End If
                tmpResult(tmpResNum) = intArray(j)
                tmpResNum = tmpResNum + 1
            End If
        Next j
        If tmpSum = intSum Then
            For k = 0 To tmpResNum - 1
                .Cells(cellRow, cellCol) = CSng(tmpResult(k)) / 100
                cellCol = cellCol + 1
            Next k
            cellRow = cellRow + 1
            cellCol = 1
        End If
        
        flag = 1
        For k = 0 To intArrayLen
            If flag = 0 Then
                Exit For
            ElseIf bitArray(k) = 0 Then
                bitArray(k) = 1
                flag = 0
            Else
                bitArray(k) = 0
            End If
        Next k

    Loop
End With
MsgBox ("FINISH!")
End Sub