福利彩票和体育彩票近两年比较火暴,相应在VB论坛上大家讨论也较多。其实选择彩票与集合选择子集相同道理。下面给出一种VB的递归算法(虽然明知存入数组会加快运算速度,但最终也没能满意地实现,请大家多多指教。另外,效率确实不高) Option Explicit
Private Sub Command1_Click()
Dim temp, i As Long, starttime As Long, endtime As Long starttime = Timer temp = cmn(22, 6) endtime = Timer Open "d:\mofn.txt" For Binary As #1 ''''写入文件 Put #1, , temp Close #1
MsgBox UBound(Split(temp, vbCrLf)) + 1 & " 种组合", 64, "共用时 " & endtime - starttime & " 秒" ''''计算组合可能情况和耗时
End Sub
Function cmn(ByVal m As Integer, ByVal n As Integer) As String '''' select n number from 1~m Dim a() As String, temp As String, i As Long
ReDim a(1 To m) ''''定义数组 For i = 1 To m a(i) = i Next
If m = 3 Then If n = 1 Then cmn = 1 & vbCrLf & 2 & vbCrLf & 3 If n = 2 Then cmn = "1,2" & vbCrLf & "1,3" & vbCrLf & "2,3" If n = 3 Then cmn = "1,2,3"
ElseIf m > 3 Then If n = 1 Then cmn = Join(a, vbCrLf) If n = m Then cmn = Join(a, ",") If n > 1 And n < m Then temp = cmn(m - 1, n - 1) ''''Debug.Print m - 1 & "," & n - 1 & vbCrLf & "----------------" & vbCrLf & temp & vbCrLf & "---------------------------" & vbCrLf ''''可以在立即窗口查看算法过程 temp = Replace(temp, vbCrLf, "," & m & vbCrLf) & "," & m cmn = cmn(m - 1, n) & vbCrLf & temp End If
End If
End Function
下面给出利用集合实现不重复随机选取某几个号码,这个函数也可用来实现数组全部元素的随机排列。
Function getone(ByVal m As Integer, ByVal n As Integer) As String '''' one random option to select n number from 1~m without repeat number Dim a() As String, temp As New Collection, i As Long, tempi As Long
ReDim a(1 To n) ''''定义数组 For i = 1 To m temp.Add i ''''可以根据需要更改
Next
Randomize For i = 1 To n tempi = Int(Rnd * temp.Count) + 1 a(i) = temp(tempi) temp.Remove tempi Next getone = Join(a, ",") Set temp = Nothing Erase a End Function
Private Sub Command2_Click()''''演示用法 MsgBox getone(30, 8), 64, "30选8 的一种选法" MsgBox getone(100, 100), 64, "1 到100 的一种不重复全排列" End Sub
没有相关教程
|