如何通过VBA实现随机抽样呢

wenbai0626

请教下各位大佬，目前有个需求就是，数据源表里面的编号是唯一不重复，如何实现通过编号随机抽取N个（比如50个），并将编号对应的其他信息也一并显示到另一个sheet中

cjc209

那么简单的问题  小菜一碟

cjc209

jsa 一句代码搞定
function test(){
        var arr=maxArray_Z("数据源!a2:e2");
        shuffle_Z(arr,"r",0).slice(0,50).toRange_Z("抽样的结果!a2")
}

wenbai0626

cjc209 发表于 2024-1-26 23:37
jsa 一句代码搞定
function test(){
        var arr=maxArray_Z("数据源!a2:e2");

请问可以用vba的代码吗

zpy2

http://club.excelhome.net/forum.php?mod=viewthread&tid=1581281&fromguid=hot&extra=&mobile=&_dsign=b189d1b7

无关岁月

副本随机抽样.7z (39.29 KB, 下载次数: 18)

2024-1-27 08:26 上传

点击文件名下载附件

gwjkkkkk

Option Explicit
Sub test2()
    Dim ar, i&, iNumber&
   
    With Sheets(1).[A1].CurrentRegion
        ar = Intersect(.Offset(), .Offset(1)).Value
    End With
    iNumber = Application.InputBox("请抽取行数", Title:="提示", Default:=50, Type:=1)
    If iNumber < 1 Or iNumber > UBound(ar) Then Exit Sub
   
    Application.ScreenUpdating = False
   
    arrGetRnd2 ar
    [A1].CurrentRegion.Offset(1).ClearContents
    [A2].Resize(iNumber, UBound(ar, 2)) = ar
   
    Application.ScreenUpdating = True
    Beep
End Sub
Function arrGetRnd2(ByRef ar, Optional ByVal isCol As Boolean)
    Dim xNum&, i&, j&, m&, n&, vTemp
    Randomize
    m = UBound(ar): n = UBound(ar, 2)
    If isCol Then vTemp = m: m = n: n = vTemp
    For i = 1 To m
        xNum = Int((m - i + 1) * Rnd() + i)
        For j = 1 To n
            If isCol Then
                vTemp = ar(j, xNum): ar(j, xNum) = ar(j, i): ar(j, i) = vTemp
            Else
                vTemp = ar(xNum, j): ar(xNum, j) = ar(i, j): ar(i, j) = vTemp
            End If
        Next
    Next
End Function

gwjkkkkk

请参考附件。。。

wenbai0626

gwjkkkkk 发表于 2024-1-27 12:22
请参考附件。。。

请问大佬，如果我的抽样结果里面没有第一行表头，全部都是空白的，代码应该怎么改，才能实现抽样结果把第一行也带进去呢

yjh_27

wenbai0626 发表于 2024-1-27 16:01
请问大佬，如果我的抽样结果里面没有第一行表头，全部都是空白的，代码应该怎么改，才能实现抽样结果把第 ...

1.     ar = Intersect(.Offset(), .Offset(1)).Value

复制代码

1 改 0