穷举彩票号码的通用过程

王朝other·作者佚名  2006-01-09
窄屏简体版  字體: |||超大  

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

 
 
 
免责声明:本文为网络用户发布,其观点仅代表作者个人观点,与本站无关,本站仅提供信息存储服务。文中陈述内容未经本站证实,其真实性、完整性、及时性本站不作任何保证或承诺,请读者仅作参考,并请自行核实相关内容。
 
 
© 2005- 王朝網路 版權所有  導航