从列表中随机选择

Question

我在 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 个值

Answer 1

这样就可以了。

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

正如评论中所讨论的，这将允许在选择的 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

请注意，如果nItemsToPick > nItemsTotal，这将永远循环!