如何用excel在一份分专业的学生名单中对不同专业按2%比例进行随机抽取

ranyrany

这边有一份学生名单，有学生的相关信息和专业，需要对每个专业按2%的比例随机抽取，该如何写公示或者代码

方方法5

希望有帮助

沈默00

去VBA版块发下，代码可以解决的
另外你需要说明一下，2%这里是按四舍五入还是什么原则

ranyrany

方方法5 发表于 2024-3-27 11:46
希望有帮助

谢谢！就是这个意思！

3190496160

Sub 随机抽取()
Dim d As Object
Set d = CreateObject("scripting.dictionary")
Set dc = CreateObject("scripting.dictionary")
With ActiveSheet
    r = .Cells(Rows.Count, 1).End(xlUp).Row
    ar = .Range("a1:b" & r)
    For i = 2 To UBound(ar)
        If ar(i, 2) <> "" Then
            If d(ar(i, 2)) = "" Then
                d(ar(i, 2)) = i
            Else
                d(ar(i, 2)) = d(ar(i, 2)) & "|" & i
            End If
        End If
    Next i
    .Columns("c:z") = Empty
    For Each k In d.keys
        y = 2
        m = 0: n = n + 1
        y = y + 1
        .Cells(n, y) = k
        rr = Split(d(k), "|")
        sl = Round((UBound(rr) + 1) * 0.2, 0)
        zx = rr(0)
        zd = rr(UBound(rr))
        dc.RemoveAll
        Do
            xh = Application.RandBetween(zx, zd)
            If Not dc.exists(xh) Then
                m = m + 1
                If m > sl Then GoTo 10
                y = y + 1
                .Cells(n, y) = ar(xh, 1)
                dc(xh) = ""
            End If
        Loop
10:
   Next k
End With
MsgBox "ok!"
End Sub

3190496160

工作簿1.rar (15.34 KB, 下载次数: 11)

2024-3-27 17:29 上传

点击文件名下载附件