一个M选N的组合算法

    最近有贴子在讨论大乐透彩票的算法，.想了一个进位的方法，比如1-9个数字选4个数字排列，就是1234排到6789，那么每个组合就是尾数累加1，只要保证各位进位的数是6789，也就是个位累加超过9向前进一位，十位累加超过8向前进一位......进位后，同时保证千位 <百倍 <十位 <个位。在网上搜索一下，VB这类算法很少，而且用递归的比较多，所以就将这个算法记录在此作个备忘吧。35选5的算法代码：

Option   Explicit

Private   Const  MaxValue  As   Long   =   35
Private   Const  MaxIndex  As   Long   =   5
Dim  Test  As   Long

Private   Sub  CarryNum(arr()  As   Long )
     Dim  Idx  As   Long
     Dim  V  As   Long
    V  =  MaxValue  -  MaxIndex
    Idx  =  MaxIndex
     Do
        arr(Idx)  =  arr(Idx)  +   1
         If  arr(Idx)  >  V  +  Idx  Then
            Idx  =  Idx  -   1
             If  Idx  =   0   Then
                Test  =   - 1
                 Exit   Sub
             End   If
         Else
             Exit   Do
         End   If
     Loop
     Do   While  Idx  <  MaxIndex
        Idx  =  Idx  +   1
        arr(Idx)  =  arr(Idx  -   1 )  +   1
     Loop
End Sub

Private   Sub  Command1_Click()
     Dim  a( 1   To  MaxIndex)  As   Long
     Dim  i  As   Long
     Dim  t  As   Double
     Dim  n  As   Long
    
    Test  =   0
    t  =   Timer
     For  i  =   1   To  MaxIndex
        a(i)  =  i
     Next
     Do
        n  =  n  +   1
        CarryNum a
     Loop  Until Test  =   - 1
     MsgBox   " 用时： "   &   Timer   -  t  &  vbCrLf  &   " 共计： "   &  n
    
End Sub

    这个代码速度还是很快的，但要输出就不能用long数组了，下面是输出测试，用了RichTextBox控件：

 

Private   Const  MaxValue  As   Long   =   35
Private   Const  MaxIndex  As   Long   =   5
Private   Const  V  =  MaxValue  -  MaxIndex

' 获得组合总数
 Private Function Total(ByVal M As Long, ByVal N As Long) As Long
    Dim i As Long
    Dim Result As Long
    Result = 1
    For i = N To 1 Step -1
        Result = Result * M / i
        M = M - 1
    Next
    Total = Result
End Function

' 进位
Private   Sub  Carry(arr(), Optional Idx  =  MaxIndex)
     Do
        arr(Idx)  =  arr(Idx)  +   1
         If  arr(Idx)  >  V  +  Idx  Then
            Idx  =  Idx  -   1
         Else
             Exit   Do
         End   If
     Loop
     Do   While  Idx  <  MaxIndex
        Idx  =  Idx  +   1
        arr(Idx)  =  arr(Idx  -   1 )  +   1
     Loop
End Sub

Private   Sub  Command2_Click()
     Dim  a( 1   To  MaxIndex)
     Dim  s()  As   String
     Dim  i  As   Long
     Dim  N  As   Long
     Dim  t  As   Double
    
    t  =   Timer
    N  =  Total(MaxValue, MaxIndex)
     ReDim  s( 1   To  N)
    RT.Text  =   ""
     For  i  =   1   To  MaxIndex  -   1
        a(i)  =  i
     Next
    a(MaxIndex)  =  MaxIndex  -   1
     For  i  =   1   To  N
        Carry a
        s(i)  =   Join (a)
     Next
    RT.Text  =   Join (s, vbCrLf)
     MsgBox   Timer   -  t  &  vbCrLf  &  N
End Sub

 

    我的赛扬2机器编译状态下输出用了3秒上下，生成EXE应该更快一点。

    改变上面示例代码中的MaxValue和MaxIndex的值，就可以得到不同组合。