CSDN博客

img xubo8219

组合的算法

发表于2008/9/28 12:16:00  158人阅读

 题目:

数组中有
1,1,2,2,3,4,5 
分别放在a(0)至a(6)位置
从这7个数字中找出
相加后 和 等于 5 的
或者 自身等于 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

0 0

相关博文

我的热门文章

img
取 消
img