Random selection from list

后端 未结 2 455
無奈伤痛
無奈伤痛 2021-01-01 06:16

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

2条回答
  •  佛祖请我去吃肉
    2021-01-01 07:20

    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 !

提交回复
热议问题