设为首页收藏本站Access中国

Office中国论坛/Access中国论坛

 找回密码
 注册

QQ登录

只需一步,快速开始

返回列表 发新帖
查看: 8920|回复: 5
打印 上一主题 下一主题

[模块/函数] 【算法】抽取不重复的随机数函数

[复制链接]

点击这里给我发消息

跳转到指定楼层
1#
发表于 2014-7-26 18:00:37 | 只看该作者 回帖奖励 |倒序浏览 |阅读模式
本帖最后由 盗梦 于 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个

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

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

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

  27.         '继续抽取
  28.         iTemp = iTemp + 1
  29.     Loop While iTemp <= lngNum

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



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

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

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



       我们抽取从1到100之间,20个不重复的随机数。
结果如下:


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





本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有帐号?注册

x
分享到:  QQ好友和群QQ好友和群 QQ空间QQ空间 腾讯微博腾讯微博 腾讯朋友腾讯朋友
收藏收藏1 分享分享 分享淘帖 订阅订阅

点击这里给我发消息

推荐
 楼主| 发表于 2014-7-31 08:58:14 | 只看该作者
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

点评

有道理!!  发表于 2014-8-10 07:33
回复 支持 1 反对 0

使用道具 举报

点击这里给我发消息

2#
发表于 2014-7-27 05:12:58 来自手机 | 只看该作者
不错,下了试试。

点击这里给我发消息

3#
发表于 2014-7-27 05:16:40 来自手机 | 只看该作者
组下标 lngRnd = Int(Rnd() * (lngLength -iTemp)) + iTemp - 1 '加上iTemp - 1 是为 了跳过前面的。

这句还没看懂,好象是取0到到长度的随机数,1到长度的,2到长度,…一直到19到长度20的。
5#
发表于 2016-4-3 13:29:23 | 只看该作者
用字典更快
您需要登录后才可以回帖 登录 | 注册

本版积分规则

QQ|站长邮箱|小黑屋|手机版|Office中国/Access中国 ( 粤ICP备10043721号-1 )  

GMT+8, 2024-11-13 14:24 , Processed in 0.081004 second(s), 35 queries .

Powered by Discuz! X3.3

© 2001-2017 Comsenz Inc.

快速回复 返回顶部 返回列表