1、无重复随机数算法一
这是最简单的算法,每产生一个随机数,就和已有的比较,如果已经存在,则重新产生。比较适合从一个大范围里面抽出一小部分数据,比如,从题库中抽取试题。
Public SubRndNumberNoRepeat1()
Dim RndNumber, temp(20), i, k, Maxrec AsInteger
Randomize (Timer) '初始化随机数生成器
Maxrec = 100 ' 从A21开始输出随机数
k = 0
Do While k < 20
RndNumber = Int(Maxrec * Rnd) + 1
temp(k) = RndNumber
Cells(k + 21, 1) = RndNumber
For i = 0 To k - 1
If temp(i) = RndNumber Then ExitFor
Next i
If i = k Then k = i + 1 'MsgBox"随机数:" & RndNumber
Loop
End Sub
2、无重复随机数算法二
这个算法比较巧妙,需要细细体会,才能知道真谛。这个算法不会重复产生随机数,但需要一个占位数组。比较适合输出范围之内所有数值的场合,比如,随机发牌。
SubRndNumberNoRepeat2()
Dim RndNumber, TempArray(99), i As Integer
Randomize (Timer) '初始化随机数生成器
For i = 0 To 99 '产生包含1-100的不重复的随机数列
TempArray(i) = i
Next i
For i = 99 To 80 Step -1
RndNumber = Int(i * Rnd)
Cells(120 - i, 1) = TempArray(RndNumber) + 1 '从A21开始输出这些数字
TempArray(RndNumber) = TempArray(i)
Next i
End Sub
3、无重复随机数算法三
这个算法使用字典对象完成去重复,和第一个算法差不多,但程序看上去简洁一点,嗯,起码新颖一点。
SubRndNumberNoRepeat3()
Dim d As Object 'New Dictionary
Dim s As Integer
Randomize (Timer) '初始化随机数生成器
Set d= CreateObject("Scripting.Dictionary")
Do Until d.Count = 20
s = Int(Rnd * 100 + 1)
d(s) = ""
Loop
[a21].Resize(d.Count, 1) =Application.Transpose(d.Keys)
End Sub