Неповторяющийся генератор случайных чисел?

Question

Я создал игру викторины с использованием Visual Basic для приложений (Excel), которая выбирает вопросы, выполняя инструкции кейса, где кейсы - это числа.У меня программа случайным образом выбирает число от 1 до максимального количества вопросов.Используя этот метод, игра повторяет вопросы.

Есть ли способ сделать что-то, что генерирует числа случайным образом (разные результаты каждый раз) и не повторяет число более одного раза?И после того, как он прошел через все числа, он должен выполнить определенный код.(Я вставлю код, который завершает игру и отображает количество вопросов, которые они получили правильно и неправильно)

Я думал о нескольких разных способах сделать это, однако я даже не мог подуматьо том, что синтаксис может быть.

Answer 1

Звучит так, будто вам нужен Array Shuffler!

Проверьте ссылку ниже - http://www.cpearson.com/excel/ShuffleArray.aspx

Function ShuffleArray(InArray() As Variant) As Variant()
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' ShuffleArray
' This function returns the values of InArray in random order. The original
' InArray is not modified.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Dim N As Long
    Dim Temp As Variant
    Dim J As Long
    Dim Arr() As Variant


    Randomize
    L = UBound(InArray) - LBound(InArray) + 1
    ReDim Arr(LBound(InArray) To UBound(InArray))
    For N = LBound(InArray) To UBound(InArray)
        Arr(N) = InArray(N)
    Next N
    For N = LBound(InArray) To UBound(InArray)
        J = CLng(((UBound(InArray) - N) * Rnd) + N)
        Temp = InArray(N)
        InArray(N) = InArray(J)
        InArray(J) = Temp
    Next N
    ShuffleArray = Arr
End Function

Sub ShuffleArrayInPlace(InArray() As Variant)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' ShuffleArrayInPlace
' This shuffles InArray to random order, randomized in place.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Dim N As Long
    Dim Temp As Variant
    Dim J As Long

    Randomize
    For N = LBound(InArray) To UBound(InArray)
        J = CLng(((UBound(InArray) - N) * Rnd) + N)
        If N <> J Then
            Temp = InArray(N)
            InArray(N) = InArray(J)
            InArray(J) = Temp
        End If
    Next N
End Sub

Answer 2

Вот еще один дубль.Он генерирует массив уникальных, случайных длин.В этом примере я использую от 1 до 100. Это делается с помощью объекта коллекции.Затем вы можете просто выполнить обычный цикл для каждого элемента массива в qArray без необходимости рандомизировать более одного раза.

Sub test()
Dim qArray() As Long
ReDim qArray(1 To 100)

qArray() = RandomQuestionArray
'loop through your questions

End Sub

Function RandomQuestionArray()  
Dim i As Long, n As Long
Dim numArray(1 To 100) As Long
Dim numCollection As New Collection

With numCollection
    For i = 1 To 100
        .Add i
    Next
    For i = 1 To 100
        n = Rnd * (.Count - 1) + 1
        numArray(i) = numCollection(n)
        .Remove n
    Next
End With

RandomQuestionArray = numArray()

End Function

Answer 3

Я вижу, у вас есть ответ, я работал над этим, но потерял подключение к Интернету. В любом случае, вот другой метод.

'// Builds a question bank (make it a hidden sheet)
Sub ResetQuestions()
    Const lTotalQuestions As Long = 300 '// Total number of questions.

    With Range("A1")
        .Value = 1
        .AutoFill Destination:=Range("A1").Resize(lTotalQuestions), Type:=xlFillSeries
    End With

End Sub
'// Gets a random question number and removes it from the bank
Function GetQuestionNumber()
    Dim lCount As Long   

    lCount = Cells(Rows.Count, 1).End(xlUp).Row      

    GetQuestionNumber = Cells(Int(lCount * Rnd + 1), 1).Value

    Cells(lRandom, 1).Delete
End Function

Sub Test()

    Msgbox (GetQuestionNumber)

End Sub

Answer 4

Во что бы то ни стало, вот мой ответ на этот вопрос. Этот использует булеву функцию вместо числовых массивов. Это очень просто, но очень быстро. Преимущество этого, которое я не говорю, является идеальным, является эффективным решением для чисел в большом диапазоне, потому что вы всегда проверяете только те числа, которые вы уже выбрали и сохранили, и вам не нужен потенциально большой массив для хранения значений вы отклонили его, поэтому это не вызовет проблем с памятью из-за размера массива.

Sub UniqueRandomGenerator()
Dim N As Long, MaxNum As Long, MinNum As Long, Rand As Long, i As Long

MinNum = 1        'Put the input of minimum number here
MaxNum = 100      'Put the input of maximum number here
N = MaxNum - MinNum + 1

ReDim Unique(1 To N, 1 To 1)

For i = 1 To N
Randomize         'I put this inside the loop to make sure of generating "good" random numbers
    Do
        Rand = Int(MinNum + N * Rnd)
        If IsUnique(Rand, Unique) Then Unique(i, 1) = Rand:  Exit Do
    Loop
Next
Sheet1.[A1].Resize(N) = Unique
End Sub

Function IsUnique(Num As Long, Data As Variant) As Boolean
Dim iFind As Long

On Error GoTo Unique
iFind = Application.WorksheetFunction.Match(Num, Data, 0)

If iFind > 0 Then IsUnique = False: Exit Function

Unique:
    IsUnique = True
End Function