求一个可以用来随机抽取人名的VBA

yzdyzd

很好用啊

yanyustar

怎么使用啊？？？

hanbanpp

看看，我也需要一个啊

张雄友

ericfei 发表于 2008-11-26 15:35
Have a try

出错。溢出的？

香川群子

ericfei 发表于 2008-11-26 15:35
Have a try

4楼楼主写的代码很不好。请认真学习，彻底放弃这个思路。

代码在随机取值过程中【非常不必要地】使用了【递归方法】，
且递归方法在数据量大时容易产生重复的随机值（每次随机取值范围都是整个范围，没有排除重复值）
因此，重复时递归【只有进、没有来得及出】，当重复次数过多时必然导致【堆栈溢出】的错误。


…………
请看我的附件：


简单几句代码就足够了！

Sub GetRnd()
    Dim arr, i&, m&, n&, r&, t
    [b2:b65536] = ""
    m = [a1].End(4).Row - 1: arr = [a2].Resize(m)
    n = Int(Val(InputBox("How many ?", "Get Rand", 238)))
    If n < 1 Or n > m Then MsgBox "HeadCounts is not correct.": Exit Sub
   
    Randomize
    For i = 1 To n
        r = Int((m - i + 1) * Rnd) + i
        t = arr(r, 1): arr(r, 1) = arr(i, 1): arr(i, 1) = t
    Next   
    [b2].Resize(n) = arr
End Sub

核心代码就蓝色几句……【经典数组洗牌算法】即可得到随机不重复乱序结果。

RandTest.rar (61.47 KB, 下载次数: 195)

2014-3-6 12:34 上传

点击文件名下载附件

香川群子

ericfei 发表于 2008-11-26 16:30
现在有重复的？？？程序里已经考虑到不重复这个问题了

随机不重复部分使用【经典数组洗牌算法】非常简洁：

  For i = 1 To n
        r = Int((m - i + 1) * Rnd) + i
        t = arr(r, 1): arr(r, 1) = arr(i, 1): arr(i, 1) = t
    Next

   代码算法解释：

  For i = 1 To n  '循环遍历抽取n个不重复值

        r = Int((m - i + 1) * Rnd) + i  '从剩余m-i+1个数中获取随机数。
                                                     '由于此范围是变动的，可保证不重复。

        t = arr(r, 1)               '随机抽到的r位置值存入临时变量t
        arr(r, 1) = arr(i, 1)     '当前第 i 个值写入r位置(本次随机值)
                                         ' →  这个过程不仅避免遗漏、和重复，还能顺便打乱顺序，效率非常之高。
        arr(i, 1) = t                '临时变量t中存放的r位置随机值，写入当前 i位置 完成交换。

    Next


详细解释抽取过程中剩余数和位置区间关系：
  
标题：   i 值   剩余个数  随机抽取范围  已排除区间
计算：     i          m-i+1        [i ,   m]             [0, i-1]
             1           m             [1,  m]              [0, 0]
             2          m - 1         [2,  m]              [0, 1]
             3          m - 2         [3,  m]              [0, 2]
             4          m - 3         [4,  m]              [0, 3]
            …………
            m-2        3           [m-2, m]              [0, m-3]
            m-1        2           [m-1, m]              [0, m-2]
             m          1            [ m , m]              [0,  m-1]


这样就明白了吧！

新增附件改为对矩形区域中数据进行随机抽取：
RandTest2.rar (11.53 KB, 下载次数: 284)

2014-3-6 12:39 上传

点击文件名下载附件

规则如下：
① 从A1开始的多列区域为源数据，第1行为列标题，允许各列数据个数(行数)不等 （即部分含有空白单元格）
② 需要抽取个数n 由对话框输入数值后(自动Int取整)，但不得大于元素总个数m，也不能<1
③ 输出结果仍按同样列数……但行数会根据n大小自动决定
④ 输出结果为源数据区域间隔1列开始，第1行留空

香川群子

关于数组洗牌法，有兴趣请看看这个帖子：

http://club.excelhome.net/thread-883690-1-1.html

renwzz

很好用，谢谢

kw1116

ericfei 发表于 2008-11-26 15:35
Have a try

正是我想要的谢谢

wangchangping

香川群子

思路很清晰，赞一个