续：求出组合后，打印到文件中

 Option Explicit

Dim sValue() As Long, sSeiban() As String, fValue() As Long, bUsed() As Boolean, strResults As String

Sub Initialize()
        strResults = ""
        Dim iLoop As Integer
        ReDim fValue(UBound(sValue))
        ReDim bUsed(UBound(sValue))
        For iLoop = 0 To UBound(sValue) - 1
                fValue(iLoop) = CLng(sValue(iLoop))
                bUsed(iLoop) = False
        Next iLoop
End Sub

Function FindResult(ByVal fTotal As Long) As Boolean
        Dim iBit     As Integer, fTemp       As Long
        FindResult = False
        Do
                iBit = 0
                Do While iBit <= UBound(bUsed) - 1
                        bUsed(iBit) = Not bUsed(iBit)
                        If bUsed(iBit) Then Exit Do
                        iBit = iBit + 1
                Loop
                If iBit > UBound(bUsed) - 1 Then Exit Function
                fTemp = 0
                For iBit = 0 To UBound(bUsed) - 1
                        If bUsed(iBit) Then fTemp = fTemp + fValue(iBit)
                Next iBit
                If Abs(fTemp - fTotal) = 0 Then
                        FindResult = True
                        Exit Function
                End If
        Loop
End Function

Function GetResult() As String
        Dim iLoop     As Integer
        GetResult = " "
        For iLoop = 0 To UBound(bUsed) - 1
                If bUsed(iLoop) Then
                        If GetResult <> " " Then GetResult = GetResult + " "
                        GetResult = GetResult & CStr(fValue(iLoop)) & " : " & sSeiban(iLoop)
                End If
        Next iLoop
End Function

Private Sub search_Click()
    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 sValue(Osize)
    ReDim sSeiban(Osize)
    Dim k As Integer
    k = 0
    Do Until rs.EOF
        sValue(k) = CLng(rs!ｽ・
        sSeiban(k) = rs!ﾖﾆｷｬ
        rs.MoveNext
        k = k + 1
    Loop
    rs.Close: Set rs = Nothing
'    MsgBox UBound(sValue)
   
    Dim bResult     As Boolean, iCount       As Integer
    Initialize
    iCount = 0
    Do
        bResult = FindResult(jyoukenn)
        If bResult Then
            iCount = iCount + 1
            strResults = strResults & "Answer " & iCount & "   is   :   " & GetResult() & vbCrLf
        End If
    Loop While bResult
    Dim fs As Object
    Dim a As Object
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set a = fs.CreateTextFile("d:/test.txt", True)
    a.WriteLine (strResults)
    a.Close
    End
End Sub

 

http://topic.csdn.net/t/20020314/20/576798.html