|
从指定名单中随机抽取样本,名单放在B列,输出结果在C、D列。
Sub Draw()
'获取名单总数,暂设名单1000以内
n = Application.WorksheetFunction.CountA(Range("sheet1!b3:b1000"))
'A列生成编号
For i = 1 To n
Sheet1.Cells(i + 2, 1) = i
Next
'检测输入抽取数是否合理
m = Val(Sheet1.TextBox1.Text)
If m = 0 Then MsgBox 48, "请输入抽取名单人数"
If m > n Then MsgBox 48, "抽取人数过多,请重新输入!"
Randomize '初始化随机数种子
Dim k As Long
ReDim arr1(1 To m, 1 To 1), arr2(1 To 1000)
Do
k = Int(Rnd * n) + 1
If arr2(k) = "" Then '检测是否重复,arr2数组有数据则表示已被抽过
arr2(k) = k
x = x + 1
arr1(x, 1) = k
End If
Loop Until x = m
'输出到表格位置
For i = 1 To m
Sheet1.Cells(i + 2, 3) = arr1(i, 1)
Sheet1.Cells(i + 2, 4) = Sheet1.Cells(arr1(i, 1) + 2, 2)
Next i
End Sub |
|