从列表中随机选择 [英] Random selection from list

问题描述

我有一个Excel工作表A1-B115中的项目列表。目前，我可以输入10个变量，从列表中检索正确的数据。

现在代码：

C1 = 1 - 通过A1-A115运行，检查值在1000-2000之间;如果是，请在某处复制B值。

C2 = 1 - 通过A1-A115运行，并检查值在2001-3000之间;如果是，请在某处复制B值。

....

我想做的是我可以输入一个值（例如：25或30），我的宏随机选择正确的值。

代码我想做：C1：30 - >从B1-B115中随机选择30个值

解决方案

这将会诀窍。

  Sub PickRandomItemsFromList（）
 
 Const nItemsToPick As Long = 10 
 Const nItemsTotal As Long = 115 
 
 Dim rngList As Range 
 Dim varRandomItems（）As Variant 
 Dim i As Long 
 
设置rngList = Range（B1）。调整大小（nItemsTotal，1）
 
 ReDim varRandomItems（1到nItemsToPick）
对于i = 1到nItemsToPick 
 varRandomItems（i）= rngList.Cells（Int（nItemsTotal * Rnd + 1），1）
接下来我
'varRandomItems现在包含nItemsToPick从范围rngList的随机项。 
 End Sub 
  

正如评论中所讨论的，这将允许单个项目被更多选择在 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 
 
设置rngList = Range（B1）。调整大小（nItemsTotal，1）
 
 ReDim idx（1到nItemsToPick）
 ReDim varRandomItems（1 To nItemsToPick）
对于i = 1 To nItemsToPick 
 Do 
 booIndexIsUnique = True'Innoncent until被证明有罪
 idx（i）= Int（nItemsTotal * Rnd + 1）
对于j = 1 To i  -  1 
如果idx（i）= idx（j）然后
'它已经在那里了。 
 booIndexIsUnique = False 
退出
结束如果
下一步j 
如果booIndexIsUnique = True然后
退出Do 
结束如果
循环
 varRandomItems（i）= rngList.Cells（idx（i），1）
 Next i 
 
'varRandomItems现在包含nItemsToPick唯一的随机
' rngList。 
 End Sub 
  

请注意，如果 nItemsToPick> ; nItemsTotal ！

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.

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.

C2=1 - run through A1-A115 and check for the value to be between 2001-3000; if so, copy the B value somewhere.

....

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.

Code I would like to do: C1: 30 -> randomly selects 30 values from B1-B115

解决方案

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 nItemsToPick picked, 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:

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 !

这篇关于从列表中随机选择的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！