组合算法以及结果输出

laoau132

for循环组合算法，21选6组合，轻松赢你一秒，你那个垃圾【递归】和【Do循环】组合算法
还敢吹天下第一，回去慢慢耕田，

laoau132

目前没有人超越你，是因为你坐井观天，自认天下第一，随便找几个出来都你快

laoau132

好失望吧，精英论坛没有人对你那个垃圾组合感兴趣，已经顶过N次，还没有人来鸟你

zpy2

香川群子 发表于 2014-10-22 15:53
附件在此。

有趣的是，为了保证输出结果的字典顺序，

太利害了 谢谢分享

zpy2

''企业余额调节
Public Used() As Byte, Used1() As Byte, n As Long
Public arr(), arr1()
Public M As Integer
Public Count As Long

Sub OneToMany()
Dim Total As Double
Dim data()
If Form1.List1.ListIndex = -1 Then
    Form1.List1.Selected(0) = True
End If
Total = Val(Split(Form1.List1.Text, "~")(0))
    For i = 0 To Form1.List2.ListCount - 1
        ReDim Preserve data(i)
        data(i) = Val(Split(Form1.List2.List(i), "~")(0))
        Form1.List2.Selected(i) = False
    Next i

Erase Used
Count = 0
n = UBound(data)
ReDim Used(UBound(data))
Solve Total, data
'select used
If Count > 0 Then
    For i = 0 To UBound(data)
        
        If Used(i) = 1 Then
            Form1.List2.Selected(i) = True
        End If
    Next i
End If
End Sub

Sub Solve(ByVal Total As Double, ByRef data, Optional ByVal firstsolution As Boolean = True) 'Get the first( or all if the 3rd param is false) combintaions which has a sum as Total
    Dim Fit As Boolean, Result() As String, Temp As Double  'Defines
   
    Do
        Fit = False 'Initialize

        Do
            For i = 0 To n
                Used(i) = 1 - Used(i) 'Used or Not used.
                If Used(i) = 1 Then Exit For
            Next
            If i > n Then Exit Do ' Nothing was found
            Temp = 0
            For i = 0 To n
            If Used(i) = 1 Then Temp = Temp + data(i) 'Get the sum of used data
            Next
            If Abs(Temp - Total) < 0.01 Then 'be same
                Fit = True 'A solution has been found.
                Exit Do 'Quit a while.
            End If
        Loop
        If Fit Then 'Return the solution found just now.
            Count = Count + 1 'Solution count
            ReDim Preserve Result(1 To Count) 'Return the solution as an array.
            For i = 0 To n
                If Used(i) = 1 Then Result(Count) = Result(Count) & "+" & data(i) 'The expression of the solution.
            Next
            Result(Count) = "Solution" & Count & ":  " & Total & "=" & Mid(Result(Count), 2) 'message of solution
            'Debug.Print Result(Count) 'Output to immediate window.
            If firstsolution = True Then Exit Sub  'Need the first solution only.
        End If
    Loop While Fit
'MsgBox IIf(Count > 1, Count & " solutions have ", IIf(Count = 0, "No ", 1) & " solution has ") & " been found!!!" 'Three options of the result: 0,1 or many
End Sub

zpy2

转一个用组合试算金额合计的

张雄友

zpy2 发表于 2015-5-3 07:59
转一个用组合试算金额合计的

附件呢？

81311610

有朝一日，我要压倒你

香川群子

zpy2 发表于 2015-5-3 07:58
''企业余额调节
Public Used() As Byte, Used1() As Byte, n As Long
Public arr(), arr1()

你这个大概是组合凑数用吧？

1堆数字、金额中，找出n个数的组合总和符合指定目标值。

…………
看着代码一大堆，实际运行效率很低的。

苏子龙

太利害了 谢谢分享