从列表中随机选择

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

    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 !