[vba]excel中求选中数据和为给定数所有的组合

昨天下午开始学习的vba，累死了，肯定有bug，待调试

vba程序如下：

 1 Dim aSum As Integer
 2 Dim tSum As Integer
 3 Dim judge(30) As Integer
 4 Dim arrMax As Integer
 5 Dim arr
 6 Dim location(30) As Integer
 7
 8 Function Test()
 9     Dim arrWmax As Integer
10     Dim Rng As Range
11     Dim beginRow As Integer
12     Dim beginLine As Integer
13
14     Set Rng = Application.InputBox(prompt:="Please Select....", Type:=8)
15     rr = Rng.Address
16     beginRow = Rng.Column
17     beginLine = Rng.Row
18
19     arr = Range(rr)
20     aSum = 0
21     arrMax = UBound(arr)
22     arrWmax = UBound(arr, 2)
23
24     For loca = 1 To arrMax
25         location(loca) = beginLine
26         beginLine = beginLine + 1
27     Next
28
29     For col = 2 To arrWmax  ‘modify
30         tSum = arr(1, col)
31         Call subTest(1, beginRow)
32     Next
33
34 End Function
35
36 Function subTest(n As Integer, beginRow As Integer)
37     If aSum > tSum Then
38         Exit Function
39     End If
40
41     Dim i As Integer
42     Dim j As Integer
43     If aSum = tSum Then
44         For i = 1 To n
45             If judge(i) = 1 Then
46                 Sheets(1).Cells(location(i), beginRow).Interior.Color = vbRed
47             End If
48         Next
49
50         Exit Function
51     End If
52
53     If n = arrMax Then
54         Exit Function
55     End If
56
57     For j = n To arrMax
58         If judge(j) = 0 Then
59             judge(j) = 1
60             aSum = aSum + arr(j, 1)
61             Call subTest(j, beginRow)
62
63             judge(j) = 0
64             aSum = aSum - arr(j, 1)
65             If j < arrMax Then
66                 While arr(j, 1) = arr(j + 1, 1)
67                       j = j + 1
68                 Wend
69             End If
70         End If
71     Next
72
73 End Function