## CSDN博客

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

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

0 0