vba 从列表中随机选择
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/5753063/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Random selection from list
提问by CustomX
I have a list of items in an Excel worksheet, A1-B115. At the moment I can enter 10 variables which retrieves the correct data from the list.
我在 Excel 工作表 A1-B115 中有一个项目列表。目前我可以输入 10 个变量来从列表中检索正确的数据。
Code now:
现在代码：
C1=1 - run through A1-A115 and check for the value to be between 1000-2000; if so, copy the B value somewhere.
C1=1 - 运行 A1-A115 并检查值是否在 1000-2000 之间；如果是这样，请将 B 值复制到某处。
C2=1 - run through A1-A115 and check for the value to be between 2001-3000; if so, copy the B value somewhere.
C2=1 - 运行 A1-A115 并检查值是否在 2001-3000 之间；如果是这样，请将 B 值复制到某处。
....
....
What I would like to do is that I can enter a value (example: 25 or 30) and that my macro randomly selects the right amount of values.
我想要做的是我可以输入一个值（例如：25 或 30）并且我的宏随机选择正确数量的值。
Code I would like to do: C1: 30 -> randomly selects 30 values from B1-B115
我想做的代码：C1: 30 -> 从 B1-B115 中随机选择 30 个值
回答by Jean-Fran?ois Corbett
This will do the trick.
这将解决问题。
Sub PickRandomItemsFromList()
Const nItemsToPick As Long = 10
Const nItemsTotal As Long = 115
Dim rngList As Range
Dim varRandomItems() As Variant
Dim i As Long
Set rngList = Range("B1").Resize(nItemsTotal, 1)
ReDim varRandomItems(1 To nItemsToPick)
For i = 1 To nItemsToPick
varRandomItems(i) = rngList.Cells(Int(nItemsTotal * Rnd + 1), 1)
Next i
' varRandomItems now contains nItemsToPick random items from range rngList.
End Sub
As discussed in the comments, this will allow individual items to be picked more than once within the nItemsToPickpicked, if for example number 63 happens to be randomly picked twice. If you don't want this to happen, then an additional loop will have to be added to check whether the item about to be picked is already in the list, for example like so:
正如评论中所讨论的，这将允许单个项目在选择中被多次nItemsToPick选择，例如，如果数字 63 碰巧被随机选择了两次。如果您不希望发生这种情况，则必须添加一个额外的循环来检查要选择的项目是否已经在列表中，例如：
Sub PickRandomItemsFromList()
Const nItemsToPick As Long = 10
Const nItemsTotal As Long = 115
Dim rngList As Range
Dim idx() As Long
Dim varRandomItems() As Variant
Dim i As Long
Dim j As Long
Dim booIndexIsUnique As Boolean
Set rngList = Range("B1").Resize(nItemsTotal, 1)
ReDim idx(1 To nItemsToPick)
ReDim varRandomItems(1 To nItemsToPick)
For i = 1 To nItemsToPick
Do
booIndexIsUnique = True ' Innoncent until proven guilty
idx(i) = Int(nItemsTotal * Rnd + 1)
For j = 1 To i - 1
If idx(i) = idx(j) Then
' It's already there.
booIndexIsUnique = False
Exit For
End If
Next j
If booIndexIsUnique = True Then
Exit Do
End If
Loop
varRandomItems(i) = rngList.Cells(idx(i), 1)
Next i
' varRandomItems now contains nItemsToPick unique random
' items from range rngList.
End Sub
Note that this will loop forever if nItemsToPick > nItemsTotal!
请注意，如果nItemsToPick > nItemsTotal!
回答by Geeniaal
I would use a collection to make sure you don't get any duplicates.
我会使用一个集合来确保你不会得到任何重复。
Function cItemsToPick(NrOfItems As Long, NrToPick As Long) As Collection
Dim cItemsTotal As New Collection
Dim K As Long
Dim I As Long
Set cItemsToPick = New Collection
If NrToPick > NrOfItems Then Exit Function
For I = 1 To NrOfItems
cItemsTotal.Add I
Next I
For I = 1 To NrToPick
K = Int(cItemsTotal.Count * Rnd + 1)
cItemsToPick.Add cItemsTotal(K)
cItemsTotal.Remove (K)
Next I
Set cItemsTotal = Nothing
End Function
You can test this function with the following code:
您可以使用以下代码测试此功能：
Sub test()
Dim c As New Collection
Dim I As Long
Set c = cItemsToPick(240, 10)
For I = 1 To c.Count
Debug.Print c(I)
Next I
End Sub
