7个text1的控件数组text1(0),text1(1)……For i = 0 To 6
Text1(i) = Int(36 * Rnd) + 1
Next i这样偶尔会出现几个相同的数字~~~~彩票中肯定不会出现相同的号码的~~~~盼望高手给个最好的算法~~~~~偶没分给了~~~sorry~~~
Text1(i) = Int(36 * Rnd) + 1
Next i这样偶尔会出现几个相同的数字~~~~彩票中肯定不会出现相同的号码的~~~~盼望高手给个最好的算法~~~~~偶没分给了~~~sorry~~~
先定义一个36位的,给以1 到36的值.数组A
在定义一个7位的,为最终结果.数组B
随机一个数,这给数为数组A的下标
将数组A的这个下标的值给与数组B
删除数组A的那个下标的值,后面的数值递进.
随机数最大值减一.
重复以上到完成
for j=i+1 to 36
for k=j+1 to 36
for l=k+1 to 36
for m=l+1 to 36
for n=m+1 to 36
for o=n+1 to 36
这里写入i & j & k & l & m & n & o
next o
next n
next m
next l
next k
next j
next i
或者
For i = 0 To 6
Text1(i) = Int(36 * Rnd) + 1
Next i
不直接赋值给Text1(i)先赋值给一变量,判断变量中是否有重复,如果有,重新来一次,如果没有重复,则赋值给文本框.
Private Sub Command1_Click()
Randomize
Dim a(1 To 36) As Integer
Dim temp As Integer
Dim rd As Integer
For i = 1 To 36
a(i) = i
Next
For j = 1 To 7
rd = Int(36 * Rnd + 1)
temp = a(j)
a(j) = a(rd)
a(rd) = temp
Debug.Print a(j)
Next
End Sub
小仙妹的跳虱算法：
Private Sub Command1_Click()
Randomize
Dim a(1 To 36) As Integer
Dim temp As Integer
Dim rd As Integer
For i = 1 To 36
a(i) = i
Next
For j = 1 To 7
rd = Int(36 * Rnd + 1)
temp = a(j)
a(j) = a(rd)
a(rd) = temp
Debug.Print a(j)
Next
End Sub===============================
还是会出现相同的号码~~~~~~~~~~~~~~~~
Dim T(1 To 35) As Byte
Randomize Timer
For I = 1 To 35
T(I) = I
Next
For I = 1 To 35
N = Int(Rnd * 35) + 1
ValueSwap T(I), T(N)
Next
For I = 1 To 7
S = S & " " & T(I)
Next
Debug.Print S
End SubSub ValueSwap(A, B)
T = A
A = B
B = T
End Sub
楼主，我的输出没有做分隔，你不会把两次的结果合在一起看所以重复了吧？？？？？？？
=============
你自己看看就知道~~~刚开始我以为你的代码还可以，后来才发现不行的我已经把你的代码输出结果显示在一个TEXT上了而且分行显示，不可能是我弄错的
B(A(I))=1
NextDim OA(1 To 7)I=0For N= 1 To 35
If CBool(B(N)) Then
I=I+1
OA(I)=N
End If
NextOA()是已经排序好的数组这种算法叫做直方图排序，是直方图算法的一个变种。直方图排序以及直方图算法、跳蚤算法都是我比较擅长使用的算法（也可以算是一种特色算法吧）。
跳蚤算法是我小时候玩抓彩票游戏的时候自己设计的。不过目前这个算法与传统算法之间的随机性是否有差别还有待找位数学专家验证。跳蚤算法的原理很简单：把第I个元素与第R个元素交换（R为随机数，L=<R=<U。L为数组最小的下标，而U为数组最大下标。由于数字交换的过程好象跳蚤一样跳来跳去没有规矩，所以叫做“跳蚤算法”，是产生类似彩票这类随机序列的比较高效的算法。它有一个好处就是：你可以只交换前7个元素，取7个元素只要7次计算。）直方图算法原本就存在，是数字图象处理当中取图象亮度直方图的酸法。我只是把它用在了别的地方而已。直方图算法的算法原理是：建立一个覆盖取值范围的数组，使数值对应的数组元素累加，这样就快速统计出每个数值出现的频率，根据频率顺序重建序列则产生排序效果（其实不是排序，但的确结果和排序一样）。比如序列：1,2,3,2,1,2,3,3,2
直方图为：T(1)=2,T(2)=4,T(3)=3（2个1、4个2、3个3）
根据直方图重建序列：1,1,2,2,2,2,3,3,3你会发现，在你有排序目的的前提下，9个数据可以用3个值来保存，似乎压缩了。其实数据并没有压缩，而是排序后丢失了原来的序列，而这个序列是一种信息（就好比不同磁场的磁介质序列可以保存数据一样）。换句话说：由于信息丢失了，所以可以用3个值来表示。你千万不要认为它能压缩数据。
Dim tmpStr As String
Dim tmpInt As Integer
Dim i As Integer
i = 0
tmpStr = ""
while i < 7
tmpInt = Int(36 * Rnd) + 1
if InStr(tmpStr, '['+CStr(tmpInt)+']') = 0 then
tmpStr = tmpStr + '['+CStr(tmpInt)+']'
Text1(i) = tmpInt
i = i + 1
end if
wend
当把一个有序序列的所有元素依次与随机位置的元素交换之后，则该序列是一个随机序列。跳蚤算法第二定律：
当把一个有序序列的前N个元素依次与随机位置的元素交换之后，则前N个元素为随机序列。跳蚤算法第三定律：
当把一个有序序列的第N个元素始终与随机位置的元素交换，则该序列不断趋向于随机序列。正在研究当中的跳蚤算法第四定律的内容：
当把一个有序序列的第N个元素始终与随机位置的元素交换，完全达到（接近）随机序列所需要的次数与交换次数、元素数量的关系。如果你编写代码的目的是制造娱乐软件（比如彩票号码产生软件），那么我很欣慰这个算法能帮助你。但是如果你觉得彩票的号码可以预测，那么我可以告诉你这是不可能的，你大可不必在这个上面浪费时间。凡是有数学常识的人都会明白其中的道理。
我自己编写类似彩票类的小东西只是为了娱乐而已，从来就不相信那东西能预测出来。至于世面上一些声称彩票缩水、预测的公司都是骗人的，除了花冤枉钱，你什么也得不到，所以千万不要相信。
相比之下，你研究如何制造时空隧道带着本彩票中奖号码记录返回10年前都比彩票缩水要现实得多。
B(A(I))=1
Next应该是For I=1 To 7
B(A(I))=B(A(I))+1
NextIf CBool(B(N)) Then
I=I+1
OA(I)=N
End If
应该是
while CBool(B(N))>0
I=I+1
OA(I)=N
wend你的算法表示还有点问题。
1 从1-37 中随机出6个不重复的数字
2 将6个数字从小到大排列3 读取TXT文件(我这里中过奖的组合 从89年到今天)
还差功能
1:将所有历史数据存如数据库
2:每次出随机数前不重复历史数据的组合
希望哪为有时间给点意见拉,代码不是很规范,上班时间偷偷写的用了半个小时左右吧,第一次用VB.NET做WINFORM
代码如下'主要算法
Private Sub generaAleatorio()
Dim lista As New ArrayList
Dim iCount, rnds, tempCount, tempRnds As Integer
Dim comprobar As Boolean
Randomize()
comprobar = True
iCount = 1
rnds = Rnd() * 36 + 1
lista.Add(rnds) 'For iCount = 0 To 5
While iCount <> 6
rnds = Rnd() * 36 + 1 For tempCount = 0 To iCount - 1
If rnds = lista.Item(tempCount) Then
comprobar = False
Exit For
End If
comprobar = True
Next tempCount If comprobar = True Then
lista.Add(rnds)
iCount = iCount + 1
End If
End While
lista.Sort() Dim a As Integer
For a = 0 To lista.Count - 1
ListBox1.Items.Add(lista(a))
Next
lista = Nothing
End Sub
For I=1 To 7
B(A(I))=1
Next应该是For I=1 To 7
B(A(I))=B(A(I))+1
Next下面的也没错。下面的语句是放在一个循环里的。
For N= 1 To 35
If CBool(B(N)) Then
I=I+1
OA(I)=N
End If
Next其中涉及两个量的增长，N和I。N是直方图的索引，范围从1到35，而I是排序后输出数组的索引，范围从1到7。如果你这么写会死循环的，也会导致OA溢出。
CBool(B(N))本身就是逻辑值，不需要CBool(B(N))>0。只要B(N)>0，CBool(B(N))必然是True。while CBool(B(N))>0
I=I+1
OA(I)=N
wend
I=I+1
OA(I)=N
wend
该是
while B(N)>0
I=I+1
OA(I)=N
B(N)=B(N)-1
wend
光顾复制了，我说的是你的排序算法，而不是讨论特例。
'If CBool(B(N)) Then '严格来说这句应该保留，但是此程序可以去掉。因为B(N)为0则CBool(B(N))为假，而B(N)为0则循环无法执行，这是For循环的特性。即使如此，写代码应当以别人容易理解为宗旨，而不是只给自己看。我不推荐你这样做。
For T=1 To B(N)
ReDim Preserve OA(I) '或者直接历遍一次B(N)，计算出OA()的真实元素数量。这里的方法健壮性强，而后者速度快。而本贴的问题只有7个元素，因此属于特例，OA()可以定义为7个元素。
OA(I)=N
I=I+1
Next
'End If
Nextwhile …… wend结构和do …… loop容易引起死循环。虽然有办法避免，但出现这种情况的机会相当大。除非执行目的不可预测，否则都该用for …… next。上述代码中，产生OA的循环外层循环是历遍直方图，其循环次数为直方图的范围。而内层循环是B(N)的数值，产生B(N)个重复元素。无论哪个都是可预测的，即使OA()数组的长度也可以预测（虽然我用的是数组随机追加法）。
另外，排序时你只能得到一个待排序列，长度和类型是可以知道的，但其范围一般都是未知的，按直方图算法你必须开辟一个涵盖最大和最小取值范围的数组，然后根据待排元素的值为该下标的大数组元素作累加运算，结束后再根据大数组元素的值重新生成已排序数组，算法的可理解性还可以，但其内存开销和算法效率绝对比不上快速算法，另外在适用数据类型上也不如后者。
无他，喜欢一起讨论简单的算法问题而已。楼上的，算是职称制度的受害者了。
text按组排Private Sub cmdok_Click()
Dim i, n As Integer
Dim Numberholder(4, 4) As String
Cmdprn.Enabled = True
Cmdok.Caption = "重 试"
For i = 0 To 4
randata(i) = rancreat(cpnum, 5) For n = 0 To 4
Numberholder(i, n) = Mid(randata(i), n * 2 + 1, 2)
Next n
Next i
For x = 0 To 4
Text1(x).Text = Numberholder(0, x)
Text2(x).Text = Numberholder(1, x)
Text3(x).Text = Numberholder(2, x)
Text4(x).Text = Numberholder(3, x)
Text5(x).Text = Numberholder(4, x)
Next x
End Sub'随即产生由n个不大于m两位数组成的字符串
Function rancreat(m As Integer, n As Integer) As String
Dim ranstring, asd As String
Dim i As Integer
Randomize
Do While (Len(ranstring) / 2 < n)
asd = CStr(Int((m * Rnd) + 1))
If asd < 10 Then
asd = "0" & CStr(asd)
Else
asd = CStr(asd)
End If
If m > 7 Then
ranstring = delsamedata(ranstring & asd)
Else
ranstring = ranstring & asd
End If
Loop
rancreat = sortdata(CStr(ranstring))
End Function
Const M = 36
Const N = 7
Dim data(36),c(7)
'初始化号码数组
For i = 1 to M
data(i) = i
Next'排序
Sub BubbleSortNumbers(iArray)
Dim i
Dim k
Dim temp
For i = UBound(iArray) To LBound(iArray) Step -1
For k = LBound(iArray) + 1 To i
If iArray(k - 1) > iArray(k) Then
temp = iArray(k - 1)
iArray(k - 1) = iArray(k)
iArray(k) = temp
End If
Next
Next
End Sub'生成机选号
Sub MyRand(m1,n1)
Dim i,k,t,temp
Randomize
For k = 1 to n1
t = Int(((m1-k+1) * Rnd) + 1)
c(k) = data(t)
'交换
temp = data(t)
data(t) = data(m1-k+1)
data(m1-k+1) = temp
Next Call BubbleSortNumbers(c)
'检查重复
For k = 1 to n1 - 1
if c(k) = c(k+1) then
Response.Write "error<br>"
k = n1
end if
Next
'输出结果
tt = ""
For k = 1 to n1
Response.Write c(k) & ","
Next
Response.Write "<br>"
End Sub'输出
For i = 1 to 100000
Call MyRand(M,N)
Response.Flush()
Next
%>