'这回行了吧
'窗体中需两个Text、两个Label、一个Command
Option Explicit
Private mlngAllNumCount As Long, mlngGetNumCount As Long
Private mblnCancelProc As Boolean, mlngCurResultCount As Long
Private mastrOneResult() As String
Private mlngFileNo As Long, mstrResultFile As String
Dim nums(9) As Integer
Private Sub Form_Load()
nums(0) = 2
nums(1) = 7
nums(2) = 10
nums(3) = 13
nums(4) = 14
nums(5) = 17
nums(6) = 19
nums(7) = 20
nums(8) = 29
nums(9) = 30
Command1.Caption = "处理"
mstrResultFile = App.Path & "\1.txt" '存放输出结果的文件，结果多时，不要尝试用记事本打开！会死机的。
End Sub
Private Sub Form_Unload(Cancel As Integer)
mblnCancelProc = True
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 mstrResultFile 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, k As Long, colget As Collection
Dim m As Long, n As Long, Num(1) As Long
On Error GoTo fail
Num(0) = 1
Set colget = New Collection '保存分母中的所有乘数（GetNum！）
For i = GetNum To 1 Step -1
colget.Add nums(i)
Next
For i = AllNum To AllNum - GetNum + 1 Step -1 '分子中所有乘数循环相乘
'让两个乘数尽可能与分母约分
Num(1) = i
For k = 0 To 1
m = colget.Count
If m > 0 Then
n = m
For j = 1 To m
If j > n Then Exit For
If Num(k) Mod colget(j) = 0 Then
Num(k) = Num(k) \ colget(j)
colget.Remove j
n = n - 1
j = j - 1
End If
Next
End If
Next
Num(0) = Num(0) * Num(1) '分子中的两个乘数分别约去分母再相乘，可防中间过程的溢出
Next
Zhuhe = Num(0)
Exit Function
fail:
End Function
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) = nums(i - 1)
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
比较麻烦哦，需要设置random值10为拖号，然后进行随机筛选
最简单的方法，使用6个一样的数组进行整合，规定下标不允许重复
rem n为nums数组下标,m+1为组个数,k为生成数对的个数
function yes(a(),b())
for i=0 to m
if a(m)=b(m) then yes=0:exit sub
next
yes=-1
end function
rem 主程序
dim a(k,m)
randomize timer
for i=1 to k
1 x=rnd*100
for j=1 to x
swap nums(int(rnd*n+1)),nums(int(rnd*n+1))
randomize timer*rnd
next
for j=1 to i-1
if yes(a(j),nums())=0 then goto 1
next
for j=0 to m
a(i,j)=nums(j);
debug.print a(i,j);
next
debug.print
next
提问者：真龙的传人 - 首席运营官 十三级
答复共 3 条
比较麻烦哦，需要设置random值10为拖号，然后进行随机筛选
最简单的方法，使用6个一样的数组进行整合，规定下标不允许重复
回答者：哪个账号没人用 - 同进士出身 六级 8-4 16:58
'明白你的意思了
内容全部来源于网络收集，如有侵权，请联系网站删除：QQ：24596024