穷举彩票号码的通用过程

Text1输入数字总个数；Text2输入每组的数字个数；App.Path & "\1.txt"用于看输出结果；Label1用于显示组个数；Command1就是执行按钮。这是一个穷举组合结果的万能代码。

Option Explicit
Private mlngAllNumCount As Long, mlngGetNumCount As Long
Private mblnCancelProc As Boolean, mlngCurResultCount As Long
Private mastrOneResult() As String
Private mlngFileNo As Long
Private Sub ListNum(ByVal Start As Long, ByVal Level As Long)
    Dim i As Long
    If mblnCancelProc Then Exit Sub
    For i = Start To mlngAllNumCount - mlngGetNumCount + Level
        mastrOneResult(Level) = i
        If Level < mlngGetNumCount Then             '是否到了最底层
            ListNum i + 1, Level + 1                '没到底，递归啦，这是本过程的核心，很简单哟
        Else
            Print #mlngFileNo, Join(mastrOneResult, vbTab)  '递归到最深层，就可以输出了
            mlngCurResultCount = mlngCurResultCount + 1
            If mlngCurResultCount Mod &H2000& = 0 Then
                Label1.Caption = mlngCurResultCount     '显示实际找出了多少组数字
                DoEvents
            End If
        End If
    Next
End Sub
Private Sub Command1_Click()
    Dim t As Single, i As Long
    If Command1.Caption = "处理" Then
        mlngAllNumCount = Text1.Text    '数字总个数
        mlngGetNumCount = Text2.Text    '每组要取的数字个数
        i = Zhuhe(mlngAllNumCount, mlngGetNumCount)
        If i = 0 Then
            MsgBox "结果太多，请不要尝试了！"
            Exit Sub
        End If
        Label2.Caption = i
        t = Timer
        mblnCancelProc = False
        Command1.Caption = "停止"
        mlngCurResultCount = 0          '已产生出的组合总数
        ReDim mastrOneResult(1 To mlngGetNumCount)
        mlngFileNo = FreeFile
        Open App.Path & "\1.txt" For Output As #mlngFileNo
            ListNum 1, 1
        Close #mlngFileNo
        Label1.Caption = mlngCurResultCount
        Command1.Caption = "处理"
        Me.Caption = Timer - t
    Else
        mblnCancelProc = True
    End If
End Sub
Private Function Zhuhe(AllNum As Long, GetNum As Long) As Long
    '算组合总数的过程，为防溢出，而做了特别设计
    '只要结果总数在20亿以内，都不会溢出的
    '太大的数不太可能会完成穷举，本程序也就不做尝试了
    '接近溢出的上限列举：65536取2、2345取3、477取4、193取5、110取6
    '75取7、58取8、49取9、40取10、39取11、37取12、35取13、34取15、33取16等
   
    Dim i As Long, j As Long, colget As Collection
    Dim m As Long, n As Long, Num1 As Long, Num2 As Long
    On Error GoTo fail
    Num1 = 1
    Set colget = New Collection
    For i = GetNum To 2 Step -1
        colget.Add i
    Next
    For i = AllNum To AllNum - GetNum + 1 Step -1
        m = colget.Count
        If m > 0 Then
            n = m
            For j = 1 To m
                If j > n Then Exit For
                If Num1 Mod colget(j) = 0 Then
                    Num1 = Num1 \ colget(j)
                    colget.Remove j
                    n = n - 1
                    j = j - 1
                End If
            Next
        End If
        Num2 = i
        m = colget.Count
        If m > 0 Then
            n = m
            For j = 1 To m
                If j > n Then Exit For
                If Num2 Mod colget(j) = 0 Then
                    Num2 = Num2 \ colget(j)
                    colget.Remove j
                    n = n - 1
                    j = j - 1
                End If
            Next
        End If
        Num1 = Num1 * Num2  '分子中的两个乘数分别消去分母再相乘，可防中间过程的溢出
    Next
    Zhuhe = Num1
    Exit Function
fail:
   
End Function
Private Sub Form_Load()
    Command1.Caption = "处理"
End Sub

Private Sub Form_Unload(Cancel As Integer)
    mblnCancelProc = True
End Sub

本文地址：http://com.8s8s.com/it/it41242.htm