# 组合的算法

题目：

1，1，2，2，3，4，5

112  a(0)a(1),a(2)
112  a(0)a(1),a(3)
23  a(2),a(3)
23  a(2),a(4)
14    a(0),a(5)
14    a(1),a(5)
5      a(6)

Option Explicit

Private Sub Carry(arr() As Long, m As Long, n As Long)
Dim idx As Long
Dim V As Long
idx = n
V = m - n
Do
arr(idx) = arr(idx) + 1
If arr(idx) > V + idx Then
idx = idx - 1
Else
Exit Do
End If
Loop
Do While idx < n
idx = idx + 1
arr(idx) = arr(idx - 1) + 1
Loop
End Sub

Sub PrintArray(a, idx() As Long, mValue As Long)
Dim i As Long
Dim sum As Long
Dim tmp As String
For i = 1 To UBound(idx)
sum = sum + a(idx(i) - 1)
tmp = tmp & " " & a(idx(i) - 1)
Next
If sum = mValue Then
Debug.Print "Answer   " & tmp & vbCrLf
MsgBox "Answer   " & tmp & vbCrLf
End If
End Sub

Private Sub search_Click()
Dim a()
Dim m As Long, n As Long
Dim i As Long, j As Long
Dim jyoukenn As Long
Dim dtFrom As Date
Dim dtTo As Date
Dim Osize As Integer

jyoukenn = CLng(Me!jyoukenn)
dtFrom = Me!DateFrom
dtTo = Me!DateTo

Dim db As DAO.Database
Dim rs As DAO.Recordset
Set db = CurrentDb
Set rs = db.OpenRecordset("select 金额,制番 from 金额 where 金额<=" & jyoukenn & " and 日付>= #" & dtFrom & "# and 日付<= #" & dtTo & "# order by 金额 asc", dbOpenDynaset)

rs.MoveLast
Osize = rs.RecordCount
rs.MoveFirst
ReDim a(Osize)

Dim k As Integer
k = 0
Do Until rs.EOF
a(k) = CLng(rs!金额)
MsgBox k & ":" & a(k)
rs.MoveNext
k = k + 1
Loop
rs.Close: Set rs = Nothing

m = Osize

For i = 1 To m
n = i
ReDim idx(n) As Long
For j = 1 To n
idx(j) = j
Next
idx(0) = -1

Do
PrintArray a, idx, jyoukenn
Carry idx, m, n
Loop Until idx(0) = 0
Next

End Sub

• 本文已收录于以下专栏：

举报原因： 您举报文章：组合的算法 色情 政治 抄袭 广告 招聘 骂人 其他 (最多只允许输入30个字)