有一列数据100个 从中随机抽取10个不重复的

gs960914

有一列数据100个  从中随机抽取10个不重复的  请教一下怎么做   

gs960914

在后面一列 排列10个不重复的

dickywjl

加到字典里去，用rnd函数随即选呗。选中了以后把这组数据抽掉就好了

香川群子

从A列中提取任意10个不重复数据的代码：

使用了【经典数组洗牌算法】

1. Sub GetRnd()
   
2.     m = [a1].End(4).Row '获取A列中A1开始单元格的最大行数m
   
3.     arr = [a1].Resize(m) '读取A列数据到数组arr
   
4.    
   
5.     n = 10 '指定要提取的数据个数n
   
6.     If n > m Then MsgBox "n>m Err!": Exit Sub
   
7.     Randomize '随机种子初始化 以保证每次得到不同的随机序列
   
8.     For i = 1 To n '遍历提取n个数据
   
9.      r = Int(Rnd * (m - i + 1)) + i '从剩余数据中得到随机位置r (注意里面剩余数计算用m 不是n)
   
10.         t = arr(r, 1): arr(r, 1) = arr(i, 1): arr(i, 1) = t
    
11.         '用临时变量t进行随机位置和当前位置的交换 保证得到随机不重复乱序结果
    
12.     Next
    
13.     [b1].Resize(n) = arr '输出结果到工作表
    
14. End Sub

复制代码

楼上各位一定要改正自己的习惯，不要再用字典什么的了……效率低。

香川群子

dickywjl 发表于 2014-3-28 12:15
加到字典里去，用rnd函数随即选呗。选中了以后把这组数据抽掉就好了

【数组洗牌算法】代码非常简洁，

请记住：

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

今后可以用在同类题目中，非常好的代码。

千万不要再想着用字典，用字典排除重复远远不如数组洗牌效率高。

jiminyanyan

学习了。。。。。

张雄友

香川群子 发表于 2014-3-28 14:43
【数组洗牌算法】代码非常简洁，

请记住：

对于只抽一次的肯定难不到你，但是对于多次抽取，请看附件。要一次一次地抽。不能一次性抽取全部输出。

百度不到去谷歌

其实字典法也挺好的 对大多人来说 效率够了 当然数组法是最快的 可是很多高人们的代码 新手们看不懂的 更不会活用
我来做点体力活吧 我把洗牌算法打包一下 只要稍有基础的人就能直接使用了
打包后的函数 只需要传递区域或者单列二维数组,以及抽取个数N,返回结果为单列二维数组
使用者无需知道内部算法 相信稍有基础就可以自由使用了 有了这个函数 随意抽取N次就变得容易了 且完全不许知道内部算法
代码如下 后有测试工作表

1. '---------Sub RndFromArr---原作:洗牌算法---整理:百度不到去谷歌  2014/3/28---------------------------
   
2. '功能 : 从单列二维数组或单元格区域中不重复随机抽取N个数,返回抽取的的二维数组(单列)
   
3. '变量 : RngArr 单元格区域或者单列二维数组,无论多行多列
   
4. '       N      要抽取的个数
   
5. '---------------------------------------------------------------------------------------------------------
   
6. Function RndFromArr(RngArr, N&)
   
7.     Dim M&, arr(), rng As Range, r&, i&, t
   
8.     If TypeName(RngArr) = "Range" Then    '接受单元格区域,无论行列,所有数据转为单列数组
   
9.         ReDim arr(1 To RngArr.Count, 1)
   
10.         For Each rng In RngArr
    
11.             M = M + 1: arr(M, 1) = rng
    
12.         Next
    
13.     Else
    
14.         arr = RngArr
    
15.     End If
    
16.     ReDim brr(1 To N, 1 To 1) '定义结果数组
    
17.     M = UBound(arr)    '
    
18.     If N > M Then RndFromArr = "Err": Exit Function
    
19.     Randomize    '随机种子初始化 以保证每次得到不同的随机序列
    
20.     For i = 1 To N    '遍历提取n个数据
    
21.         r = Int(Rnd * (M - i + 1)) + i  '从剩余数据中得到随机位置r (注意里面剩余数计算用m 不是n)
    
22.         t = arr(r, 1): arr(r, 1) = arr(i, 1): brr(i, 1) = t
    
23.         '用临时变量t进行随机位置和当前位置的交换 保证得到随机不重复乱序结果
    
24.     Next
    
25.     RndFromArr = brr
    
26. End Function
    
27. Sub test()
    
28.     Dim i&
    
29.     [B3:IV65536] = ""
    
30.     For i = 1 To 5 '抽取5次依次从C3往右竖向输出,A列数数据源,B1数抽取个数
    
31.         [C3].Resize([B1]).Offset(0, i) = RndFromArr(Range([a1], [a65536].End(xlUp)), 10) '输出结果到工作表
    
32.     Next
    
33.     For i = 1 To 5 '[C1:P1]抽取10个,抽5次依次从R4横向往下输出
    
34.         [R3].Resize(1, [B1]).Offset(i, 0) = WorksheetFunction.Transpose(RndFromArr([C1:P1], 10)) '输出结果到工作表
    
35.         '注意横向输出时对函数结果转置
    
36.     Next
    
37. End Sub

复制代码

随机抽取-通用工具.rar (16.4 KB, 下载次数: 602)

2014-3-28 22:37 上传

点击文件名下载附件

香川群子

张雄友 发表于 2014-3-28 20:52
对于只抽一次的肯定难不到你，但是对于多次抽取，请看附件。要一次一次地抽。不能一次性抽取全部输出。

你这不是脑子糊涂了吗……100个数据一次性打乱随机，再分成10组不就都满足要求了。

张雄友

香川群子 发表于 2014-3-28 22:40
你这不是脑子糊涂了吗……100个数据一次性打乱随机，再分成10组不就都满足要求了。

但是不是每次都抽10个的，一次可以抽1个，2个，56个，等等...... 后一次抽就是要减去前面已抽的再去抽。