excel按班级分组，每组按百分比随机抽取数据，两次抽取不重复

文章目录

需求

有一张学生班级信息表，需要按每个班的人数比例，每次随机抽取6%的学生，且第二次抽取与第一次抽取的结果不能重复：

信息表如下图：

一、实现方案

使用VB编程，在开发工具，VB编辑器中插入一个模块，然后粘贴下面的代码并运行即可实现，按照A列分组并抽取6%的学生按C列区分存入sheet2

二、代码详情

Sub Getdates()brr = Sheet2.Range("A1:D" & Sheet2.Cells(Rows.Count, "A").End(3).Row)arr = Sheet1.Range("A1:C" & Sheet1.Cells(Rows.Count, "A").End(3).Row)Dim t As Datet = Now()ReDim br(1 To UBound(arr), 1 To 4)Set d = CreateObject("scripting.dictionary")Set d1 = CreateObject("scripting.dictionary")Set d2 = CreateObject("scripting.dictionary")For I = 2 To UBound(brr)d1(brr(I, 4)) = ""NextFor I = 2 To UBound(arr)d2(arr(I, 1)) = d2(arr(I, 1)) + 1If Not d1.exists(arr(I, 3)) Thend(arr(I, 1)) = d(arr(I, 1)) & "," & IEnd IfNextar = d.itemscr = d.keysd.RemoveAlld1.RemoveAllFor I = 0 To UBound(ar)arT = Split(Mid(ar(I), 2), ",")' 6%后四舍五入imax = Rand(d2(cr(I)) * 0.06)If imax = o Thenimax = 1End IfIf UBound(arT) > 0 ThenDo While x < imaxnum = WorksheetFunction.RandBetween(0, UBound(arT))If Not d.exists(num) Thend(num) = ""x = x + 1k = k + 1br(k, 1) = tbr(k, 2) = arr(arT(num), 1)br(k, 3) = arr(arT(num), 2)br(k, 4) = arr(arT(num), 3)End IfIf d.Count = UBound(arT) + 1 ThenExit DoEnd IfLoopd.RemoveAllx = 0imax = 0Elsek = k + 1br(k, 1) = tbr(k, 2) = arr(arT(0), 1)br(k, 3) = arr(arT(0), 2)br(k, 4) = arr(arT(0), 3)End IfNextIf k > 0 ThenSheet2.Range("A" & Sheet2.Cells(Rows.Count, "A").End(3).Row + 1).Resize(k, 4) = brErase brEnd IfErase arrErase brrSet d2 = NothingSet d = NothingSet d1 = NothingEnd Sub

注意事项

VB编辑器，office任意版本均有；但WPS则需要专业版才有；或者是免费版但安装了VB编辑器插件