Office中国论坛/Access中国论坛

标题: 【算法】抽取不重复的随机数函数 [打印本页]
作者: 盗梦    时间: 2014-7-26 18:00
标题: 【算法】抽取不重复的随机数函数
本帖最后由 盗梦 于 2014-7-26 18:05 编辑

       有时候，我们需要抽取一些随机数，而且这些随机数不能重复。简单的做法，就是每抽取一次随机数，就把这个随机数和前面抽取出来的比较，如果重复就重新抽取，直到不重复为止。
       当这样做的效率很低。需要抽取的数量很大时，这种做法速度相当的慢。

       可以这么思考，我们抽取随机数，就好比摇奖。摇出的数字，就取出，不参与下一次摇奖。这样自然而然的就不会重复了。
       下面我要讲的算法是利用数组。数组的值是我们要抽取的值，数组的下标就是我们用于随机的数。把这两个分开，就容易实现不重复的效果。

代码如下：
       '函数：funcUnSameRnd；
       '参数1：要抽取随机数范围的最小值，
       '参数2：要抽取随机数范围的最大值，
       '参数3：要抽取不重复随机数的个数。

  1. Public Function funcUnSameRnd(lngLow As Long, lngUp As Long, lngNum As Long)
  2.     '判断要获取的个数
  3.     Dim lngLength As Long
  4.     lngLength = lngUp - lngLow + 1                  '获取长度
  5.     If lngNum > lngLength Then lngNum = lngLength   '若要获取随机数的个数大于长度，则数量改为最大长度
  6.     If lngNum < 1 Then lngNum = 1                   '随机数的个数不能少于1个

  8.     '初始化数组 数组的下标从 0 ~ 最大长度-1，数组的值从 lngLow 到 lngUp
  9.     Dim arr(), i As Integer, iTemp As Long
  10.     ReDim arr(lngLength - 1)
  11.     iTemp = lngLow
  12.     For i = 0 To lngLength - 1
  13.         arr(i) = iTemp
  14.         iTemp = iTemp + 1
  15.     Next

  17.     '抽取随机数
  18.     Randomize               '重置随机器
  19.     Dim lngRnd As Long      '用于存在返回的随机数
  20.     Dim lngTemp As Long     '两个变量调换的中间临时变量
  21.     iTemp = 1
  22.     Do
  23.         '抽取随机数 0 ~ lngLength-1 获取数组下标
  24.         lngRnd = Int(Rnd() * (lngLength - iTemp)) + iTemp - 1 '加上iTemp - 1 是为了跳过前面已经抽取的值，避免覆盖

  26.         '调换值，将抽取到的随机数下标对应的值放到前面，之所以放到前面，是为了方便返回结果
  27.         lngTemp = arr(iTemp - 1)
  28.         arr(iTemp - 1) = arr(lngRnd)
  29.         arr(lngRnd) = lngTemp

  31.         '继续抽取
  32.         iTemp = iTemp + 1
  33.     Loop While iTemp <= lngNum

  35.     '返回结果，截取抽取的随机数个数，Preserve 关键字作用是ReDim重新定义不清除值
  36.     ReDim Preserve arr(lngNum - 1)
  37.     funcUnSameRnd = arr
  38. End Function
复制代码



       这个函数，可以轻松地得到我们想要的结果。测试一下

测试函数：
  1. Public Function funcTest()
  2.     Dim ar()
  3.     ar = funcUnSameRnd(1, 100, 20) '从1到100中，抽取20个不重复的随机数

  5.     '打印值
  6.     Dim i As Integer
  7.     For i = 0 To UBound(ar)
  8.         Debug.Print "第" & i + 1 & "个随机数：" & ar(i)
  9.     Next
  10. End Function
复制代码



       我们抽取从1到100之间，20个不重复的随机数。
结果如下：
[attach]54304[/attach]

        我又测试了，从1到100，抽取100个不重复的随机数，结果完全正确。大家可以自己试一下。
而且，这个函数效率相当高。





作者: zpy2    时间: 2014-7-27 05:12
不错，下了试试。
作者: zpy2    时间: 2014-7-27 05:16
组下标 lngRnd = Int(Rnd() * (lngLength -iTemp)) + iTemp - 1 '加上iTemp - 1 是为 了跳过前面的。

这句还没看懂，好象是取0到到长度的随机数，1到长度的，2到长度，…一直到19到长度20的。
作者: 盗梦    时间: 2014-7-31 08:58
zpy2 发表于 2014-7-27 05:16
组下标 lngRnd = Int(Rnd() * (lngLength -iTemp)) + iTemp - 1 '加上iTemp - 1 是为 了跳过前面的。

这 ...

这句是有点绕。假如 第1次抽取随机数，范围是在1-100。而第2次抽取随机数，范围需要在2-100，也就是1-99 的结果加上1，1也是2-1
作者: Office-菜鸟    时间: 2016-4-3 13:29
用字典更快



欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/) Powered by Discuz! X3.3