请教老师，如何用VBA,按提取数量值，随机抽取，谢谢！

cartel

请教老师，如何用VBA,按提取数量值，随机抽取，谢谢！.zip (21.96 KB, 下载次数: 11)

2023-3-8 20:57 上传

点击文件名下载附件

cjc209

请参考                                   

准提部林

Sub TEST_A1()
Dim S&, R&, V&, Arr, Brr
R = Cells(Rows.Count, 4).End(3).Row
S = Val(InputBox("please enter a number"))
If S <= 0 Or S > R Then Exit Sub
Arr = Range("d1:d" & R): ReDim Brr(1 To S, 0)
Randomize
For i = 1 To S
    V = Int(Rnd * R) + 1
    Brr(i, 0) = Arr(V, 1)
    Arr(V, 1) = Arr(R, 1)
    R = R - 1
Next i
[e:e].ClearContents
[e1].Resize(S) = Brr
End Sub

剑指E

1. Private Sub CommandButton1_Click()
   
2.     Dim d As Object, ar, br(), i&, n, a
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     ar = Me.Range("d1").CurrentRegion
   
5.     Range("e:e").ClearContents
   
6.     For i = 1 To UBound(ar)
   
7.         d(i) = ar(i, 1)
   
8.     Next
   
9.     i = 0
   
10.     n = InputBox("输入：", "只能输入数字")
    
11.     ReDim br(1 To n, 1 To 1)
    
12.     Do While i < n
    
13.         i = i + 1
    
14.         a = Application.RandBetween(1, d.Count) - 1
    
15.         br(i, 1) = d(d.keys()(a))
    
16.         d.Remove d.keys()(a)
    
17.     Loop
    
18.     [e1].Resize(n) = br
    
19. End Sub

复制代码

gwjkkkkk

请参考。。。