Random 从列表中随机选择

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

pick中多次拾取单个项目，例如，如果数字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

，这将永远循环

我会使用一个集合来确保你不会得到任何重复的

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

您可以使用以下代码测试此函数：

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

---

我想问题是：一个单元格的值可以被多次拾取吗？宏的结果应该只是X个随机单元格的选择（多范围高亮显示，就像用Ctrl键选择多个单元格），还是需要将结果粘贴到某个地方？是否允许在输出中有相同的元素两次。嗯，我想我的问题不太清楚，我会编辑它。