迎中秋 【香川巨量随机取数】程序发布

香川群子

具体请看附件，不懂来问。

附件更新，改为自定义函数版用法：
香川巨量随机取数20140828.rar (23.83 KB, 下载次数: 497)

2014-8-31 23:00 上传

点击文件名下载附件

1. Sub kagawa()
   
2.     If [g2] = 0 Then [g2] = 5 '列数指定不能为0
   
3.     [a5].CurrentRegion.Offset(1) = "" '清空输出区域
   
4.     [a6].Resize([c2] \ [g2] + 1, [g2]) = GetRndAvg([a2], [b2], [c2], [d2], [e2], [h2], [g2]) '按指定列数输出结果
   
5. End Sub
   
6. 
   
7. Function GetRndAvg(a, b, m, Optional d = 0, Optional h = 1, Optional s = 1, Optional l = 5) '指定区间内 均匀随机取不重复值 按指定列数输出
   
8. '    Dim a, b, c(), d, f(), h, i, l, m, n, r, t '因为数值个数会超Long范围，所以不应该定义数据类型
   
9. '     [f2]=IF(E2,INT((B2-A2)*10^D2/E2)+1,"无限")
   
10.      
    
11. '    d = [d2] '小数位数d 用法同=Round(,numdecimalplaces)的第2参数 零为整数、正数为小数、负数为个十百千位向上取整
    
12. '    a = [a2] * 10 ^ d '取值下限、自动按小数位设置扩大/缩小
    
13. '    b = [b2] * 10 ^ d '取值上限、自动按小数位设置扩大/缩小
    
14. '    m = [c2] '取值个数 F2单元格中公式计算取值允许个数 =IF(E2,INT((B2-A2)*10^D2/E2)+1,"无限")
    
15. '    h = [e2] '最小间隔步长 h=0时允许重复。而h不为零时如取值个数大于取数范围则取数不足部分返回=0
    
16. '    l = [g2] '输出时列数指定 行数自动=m\l
    
17. '    s = [h2] '输出时是否排序 s=0时返回随机乱序(数组洗牌法)、s=1时按从小到大升序输出
    
18.     a = a * 10 ^ d
    
19.     b = b * 10 ^ d
    
20.    
    
21.     Randomize
    
22.     ReDim c(m - 1) '按取值个数定义存放结果的数组c
    
23.     If b - a < m * h Then c(0) = a Else c(0) = Int(((b - a + 1) / m - h) * Rnd) + a '首位取值*Rnd即可
    
24. '    n = 0 当前取值个数
    
25.     Do
    
26.         If b - c(n) < (m - n) * h Then
    
27.             If c(n) + h > b Then Exit Do Else c(n + 1) = c(n) + h
    
28.         Else
    
29.             c(n + 1) = c(n) + Int(((b - c(n) + 1) / (m - n) - h) * Rnd * 2) + h
    
30.             '取数原理为： 上个值c(n) + 剩余范围(b - c(n) + 1) 除以剩余个数(m - n)得到的均匀区间
    
31.             '             并扣除最小间隔h然后 乘以2倍随机数 Rnd*2 取值  再加上最小间隔h
    
32.             '其中关键是 要乘以2倍随机数 Rnd*2 取值 这是因为Rnd的期望平均值=0.5
    
33.         End If
    
34.         n = n + 1
    
35.     Loop Until n = m - 2 '到剩下最后一个时停止 (因最后一个的计算方法不同)
    
36.     If c(n) + h <= b Then c(m - 1) = c(n) + Int((b - c(n) + 1 - h) * Rnd) + h '末位取值*Rnd即可
    
37.    
    
38.     ReDim f(m \ l, l - 1) '按指定列数计算所需行数后定义存放结果的数组f
    
39.     If s = 0 Then 's=0时返回随机乱序(数组洗牌法)
    
40.         For i = 0 To m - 1
    
41.             r = Int((m - i) * Rnd) + i '数组洗牌算法进行不重复随机乱序抽取
    
42.             f(i \ l, i Mod l) = c(r) / 10 ^ d '该随机位置结果按指定小数位换算后输出
    
43.             c(r) = c(i) '该随机位置和当前位置值交换 防止遗漏
    
44.             
    
45. '            t = c(r): c(r) = c(i): c(i) = c(r) '抽取后进行位置交换 保证不重复以及无遗漏
    
46. '            f(i \ l, i Mod l) = t / 10 ^ d '结果按指定小数位换算
    
47.         Next
    
48.     Else 's=1时按从小到大升序输出
    
49.         For i = 0 To m - 1
    
50.             f(i \ l, i Mod l) = c(i) / 10 ^ d '结果按指定小数位换算
    
51.         Next
    
52.     End If
    
53.    
    
54. '    [a5].CurrentRegion.Offset(1) = "" '清空输出区域
    
55. '    [a6].Resize(m \ l + 1, l) = f '按指定列数输出结果
    
56.     GetRndAvg = f '数组结果赋值给该函数
    
57.    
    
58. End Function
    

复制代码

百度不到去谷歌

抢女侠的沙发坐坐

天地有雪

谢谢香川老师分享！果然收藏了！

EXCEL江湖

昨天刚学习了裙子老师的贴，裙子老师就公布了！学习收藏！

loquat

群子老师治学很严谨

1729434161

谢谢您的帮助，收藏学习

香川群子

去年的帖子了……顶一下。

香川群子

个人宏更新

sucx007

谢谢香川老师分享！果然收藏了！

jinhaitiao16

谢谢香川老师分享！果然收藏了！