首页 > 代码库 > 【VBA研究】VBA产生不重复随机数
【VBA研究】VBA产生不重复随机数
作者:iamlasong
VBA编程实现不重复随机数输出。VBA里的随机函数是RND,在工作表中随机函数是RAND,一字之差,可要记好了。RND取值范围是[0,1),意思是0和1之间的一个随机数,包含0,但不包含1。
1、用法
语法:Rnd[(number)]
如果 number 的值是 Randomize 生成
小于 0 ,每次都使用 number 作为随机数种子得到的相同结果。
大于 0 ,以上一个随机数为种子产生下一个随机数。
等于 0 ,产生与最近生成的随机数相同的随机数。
省略, 以上一个随机数为种子产生下一个随机数。
说明:
Rnd 函数返回小于 1 但大于或等于 0 的值。
number 的值决定了 Rnd 生成随机数的方式。
对最初给定的种子都会生成相同的数列,因为每一次调用 Rnd 函数都用数列中的前一个数作为下一个数的种子。
在调用 Rnd 之前,先使用无参数的 Randomize 语句初始化随机数生成器(若带参数,则产生由参数对应的一个特定序列的随机数),该生成器具有根据系统计时器得到的种子。
为了生成某个范围内的随机整数,可使用以下公式:
Int((upperbound - lowerbound + 1) * Rnd + lowerbound)
这里,upperbound 是随机数范围的上限,而 lowerbound 则是随机数范围的下限。
注意:若想得到重复的随机数序列,在使用具有数值参数的 Randomize 之前直接调用具有负参数值的 Rnd。使用具有同样 number 值的 Randomize 是不会得到重复的随机数序列的。
2、无重复随机数算法一
这是最简单的算法,每产生一个随机数,就和已有的比较,如果已经存在,则重新产生。比较适合从一个大范围里面抽出一小部分数据,比如,从题库中抽取试题。
' 产生20个1-100之间的不重复随机数 Public Sub RndNumberNoRepeat1() Dim RndNumber, temp(20), i, k, Maxrec As Integer Randomize (Timer) '初始化随机数生成器 Maxrec = 100 temp(0) = Int(Maxrec * Rnd) + 1 Cells(21, 1) = temp(0) ' 从A21开始输出随机数 k = 1 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 Exit For Next i If i = k Then k = i + 1 'MsgBox "随机数:" & RndNumber Loop End Sub
3、无重复随机数算法二
这个算法比较巧妙,需要细细体会,才能知道真谛。这个算法不会重复产生随机数,但需要一个占位数组。比较适合输出范围之内所有数值的场合,比如,随机发牌。
' 产生20个1-100之间的不重复随机数 Sub RndNumberNoRepeat2() 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) '从A21开始输出这些数字 Cells(120 - i, 1) = TempArray(RndNumber) + 1 TempArray(RndNumber) = TempArray(i) Next i End Sub
4、无重复随机数算法三
这个算法使用字典对象完成去重复,和第一个算法差不多,但程序看上去简洁的多。
' 产生20个1-100之间的不重复随机数 Sub RndNumberNoRepeat3() 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
附:VBA中Dictionary对象使用小结
Dim dict
‘ 创建Dictionary
Set dict = CreateObject("Scripting.Dictionary")
‘ 增加项目
dict.Add "A", 300
dict.Add "B", 400
dict.Add "C", 500
‘ 统计项目数
n = dict.Count
‘ 删除项目
dict.Remove ("A")
‘ 判断字典中是否包含关键字
dict.exists ("B")
‘ 取关键字对应的值,注意在使用前需要判断是否存在key,否则dict中会多出一条记录
Value = http://www.mamicode.com/dict.Item("B")
‘ 修改关键字对应的值,如不存在则创建新的项目
dict.Item("B") = 1000
dict.Item("D") = 800
‘ 对字典进行循环
k = dict.keys
v = dict.Items
For i = 0 To dict.Count - 1
key = k(i)
Value = http://www.mamicode.com/v(i)
MsgBox key & Value
Next
‘ 删除所有项目
dict.Removeall
实例:
Sub 宏1()Set dic = CreateObject("Scripting.Dictionary") ‘字典
For i = 1 To 10000
If Not i Like "*4*" Then
dic.Add i, "" ‘如果不包含“1”
End If
Next
Range("a2").Resize(dic.Count, 1) = Application.WorksheetFunction.Transpose(dic.keys) ‘从A2单元开始向下放置
End Sub
=========================================================================
又 Tranpose工作表函数的用法实例
‘把一行多列的二维数组转换成一维数组
Sub test()
Dim arr, arrt
arr = Range("a1:j1")
arrt = WorksheetFunction.Transpose(WorksheetFunction.Transpose(arr))
Stop
End Sub
首先看看TRANSPOSE函数的基础用法。官方帮助说明,TRANSPOSE函数可返回转置单元格区域,即将行单元格区域转置成列单元格区域,反之亦然。
TRANSPOSE函数语法是:TRANSPOSE(array)
Array参数是需要进行转置的数组或工作表上的单元格区域。所谓数组的转置就是,将数组的第一行作为新数组的第一列,数组的第二行作为新数组的第二列,以此类推。