不放回随机抽取(每次抽取数随机，抽完为止)

作者：绿色风分类：时间：2022-08-17 浏览：144

楼主
芐雨

随机不重复抽取(每次抽取数随机，抽完为止)
要求：
1.每次抽取数随机
2.抽取完之后不放回，即在剩下的数中抽取
3.抽完为止

例如：有一箱苹果（m个），很多人在排队拿苹果(想拿多少就拿多少)，第一个人拿了x个（可以是1个，4个或全部)，拿了就走，接着第二个人拿了y 个，
第三个......每个人拿的苹果数随机。拿完为止。

代码：

Sub 不放回随机抽取_芐雨()
m = [a2].End(4).Row - 1 '获取A列中A1开始单元格的最大行数m
arr = [a2].Resize(m) '读取A列数据到数组arr
Randomize '随机种子初始化以保证每次得到不同的随机序列
ReDim brr(1 To UBound(arr), 1 To 1)
Range("C1:Z" & Rows.Count).Clear
Do
n = Int(Rnd * (m - temp)) + 1 '指定要提取的数据个数n
temp = n + temp '计算已提取的数据个数temp
j = 0 '初始化
For i = temp - n + 1 To temp '从上一次提取完的位置，遍历提取n个数据
j = j + 1
r = Int(Rnd * (m - i + 1)) + i '从剩余数据中得到随机位置r (注意里面剩余数计算用m 不是n)
t = arr(r, 1): arr(r, 1) = arr(i, 1): arr(i, 1) = t
'用临时变量t进行随机位置和当前位置的交换保证得到随机不重复乱序结果
brr(j, 1) = t '放入数组brr中
Next
[C1].Offset(0, x) = "第" & x + 1 & "次抽取"
[C2].Offset(0, x).Resize(n) = brr '输出结果到工作表
x = x + 1
Loop Until m - temp = 0 'm-temp= 0时跳出
End Sub

代码原理图：

附件：

不放回随机抽取(抽完为止)_芐雨.zip

2楼
老糊涂

这个有用

免责声明

有感于原ExcelTip.Net留存知识的价值及部分知识具有的时间限定性因素，经与ExcelTip.Net站长Apolloh商议并征得其同意，现将原属ExcelTip.Net的知识帖采集资料于本站点进行展示，供有需要的人士查询使用，也慰缅曾经的论坛时代。所示各个帖子的原作者如对版权有异议，可与本人沟通提出，或于本站点留言，我们会尽快处理。在此，感谢ExcelTip.Net站长Apolloh的支持，感谢本站点所有人**绿色风（QQ:79664738)**的支持与奉献，特此鸣谢！
------本人网名**KevinChengCW（QQ:1210618015)**原ExcelTip.Net总版主之一

评论列表