随机数生成问题，求高人指导！

jonasbinc

sheet1为在H1：H60生成1-60随机不重复数，现有需要在某列也生成不重复随机数，但是要求诸如sheet2，各班人数并不均等，在不同色块间如何通过计算有多少人来获得随机数取值范围，并能准确对随机数进行填写（每个色块间的取值范围均从1开始，最大值由计数获得），能将Bsheet1代码修改实现吗？不能实现请帮重写代码！
现在的错误问题就是如果一直调用BOOK1 "suiji"宏将都只会生成60个数，不管你色块位置到哪 它都肯定填充60个数字，那样就不能实现预期随机目的了，怎么写变量代码，菜鸟求教！

简言之，目的就是实现各班人数不均等，纵向生成不重复随机数（随机数范围均从1开始），并准确填写到相应单元格。

不知道说清楚没！
在线等！求大侠们指教！

问题样式.zip (11.47 KB, 下载次数: 14)

2014-3-29 17:23 上传

点击文件名下载附件

hhjjpp

普通公式就能实现，需要你具体模拟出一个计算成果来

hhjjpp

还有每个班多少人（不是要随机抽取的名额）非要用颜色来表示吗？
即使用颜色也能搞定

bluexuemei

1. 
   
2. Sub tt()
   
3. '请安装ActiveRuby然后运行以下代码，下载地址  http://www.artonx.org/data/asr/ActiveRuby.msi
   
4. Dim ojs As Object, n%, t%, i&
   
5. Set ojs = CreateObject("scriptcontrol"): ojs.Language = "rubyscript"
   
6. n = 0: t = 0
   
7. For i = 2 To Rows.Count
   
8.      If Sheet2.Cells(i, "H").Interior.Color = 16777215 And Sheet2.Cells(i - 1, "H").Interior.Color = 16777215 Then Exit Sub
   
9.      If Sheet2.Cells(i, "H").Interior.Color = Sheet2.Cells(i - 1, "H").Interior.Color Then
   
10.           n = n + 1
    
11.      Else
    
12.          t = t + 1
    
13.          Sheet1.Cells(1, 7 + t).Resize(n + 1) = Application.Transpose(ojs.eval("(1.." & n + 1 & ").to_a.shuffle"))
    
14.          n = 0
    
15.      End If
    
16. Next
    
17. Set ojs = Nothing
    
18. Stop
    
19. End Sub

复制代码

百度不到去谷歌

还调用ruby有点麻烦了啊原生的就挺好 另外我看根据合并单元格判定好一点 也免得去打颜色了
代码如下

1. Sub 按钮1_Click()
   
2.     Dim r As Range, rF As Range
   
3.     Set r = [G1].MergeArea
   
4.     Do
   
5.         Set rF = r.Offset(0, -1)
   
6.         Set rF = Range("F" & r.Row & ":F" & r.End(xlDown).Row - 1) '定位F列有效区域
   
7.         rF.Offset(0, 2) = RndFromArr(rF.Value, rF.Count)  '获取随机数并写入H列
   
8.         Set r = r.End(xlDown) '下一个合并单元格
   
9.         If r.Row = 65536 Then Exit Do
   
10.         Debug.Print r.MergeArea.Address
    
11.     Loop
    
12. End Sub
    
13. '---------通用函数-RndFromArr----原作:洗牌算法--整理:百度不到去谷歌--2014-3-27
    
14. '功能:  从单列二维数组或单元格区域中不重复随机抽取N个数 , 返回抽取的的二维数组(单列)
    
15. '变量 : arr 单列单元格区域/单列二维数组
    
16. '       N      要抽取的个数
    
17. '---------------------------------------------------------------------------------------------------------
    
18. Function RndFromArr(arr, N&)
    
19.     Dim M&, rng As Range, r&, i&, t
    
20.     ReDim brr(1 To N, 1 To 1) '定义结果数组
    
21.     M = UBound(arr)    '
    
22.     If N > M Then RndFromArr = "Err": Exit Function
    
23.     Randomize    '随机种子初始化 以保证每次得到不同的随机序列
    
24.     For i = 1 To N    '遍历提取n个数据
    
25.         r = Int(Rnd * (M - i + 1)) + i  '从剩余数据中得到随机位置r (注意里面剩余数计算用m 不是n)
    
26.         t = arr(r, 1): arr(r, 1) = arr(i, 1): brr(i, 1) = t
    
27.         '用临时变量t进行随机位置和当前位置的交换 保证得到随机不重复乱序结果
    
28.     Next
    
29.     RndFromArr = brr
    
30. End Function

复制代码

jonasbinc

hhjjpp 发表于 2014-3-29 17:53
普通公式就能实现，需要你具体模拟出一个计算成果来

sheet2呀！

jonasbinc

百度不到去谷歌 发表于 2014-3-29 19:18
还调用ruby有点麻烦了啊原生的就挺好 另外我看根据合并单元格判定好一点 也免得去打颜色了
代码如下

色块是我为了直观说明不同区域同样随机取值的！不是要用颜色来判断！能不能不用单元格合并让数出多少人，然后确定随机数取值范围？

jonasbinc

hhjjpp 发表于 2014-3-29 18:00
还有每个班多少人（不是要随机抽取的名额）非要用颜色来表示吗？
即使用颜色也能搞定

每班多少人就用每班的人数作为取值范围！不需要用颜色！谢谢

百度不到去谷歌

jonasbinc 发表于 2014-3-29 19:35
色块是我为了直观说明不同区域同样随机取值的！不是要用颜色来判断！能不能不用单元格合并让数出多少人， ...

要么用颜色,要么用合并单元格 你总得给一个标识来确定一个班级的范围才行啊

百度不到去谷歌

如果直接用每个起始人数1做标识也可以 你得确定一个 核心算法是随机 判定你只要能说出规律
怎么都行 你直接告诉你的最终表格的条件是什么