非重複隨機數發生器？

Question

我創建使用的應用程序的Visual Basic（EXCEL），其通過一個case語句，其中病例數會選擇問題一個小遊戲。我有程序從1到最大數量的問題中隨機選擇一個數字。使用這種方法，遊戲重複問題。

有沒有辦法使一些隨機生成的數字（每次不同的結果），不重複數超過一次？並且在它完成了所有需要執行某個代碼的數字之後。 （我會在那結束了比賽，並顯示他們得到了正確的，得到了​​錯誤的題數代碼）

我想到了幾個不同的方法可以做到這一點，但是我不能，甚至開始想什麼語法可能是。

Answer 1

聽起來像是你需要一個數組洗牌！

退房下面的鏈接 - 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

我看到你有一個答案，我在做這一點，但失去了我的互聯網連接。無論如何，這裏是另一種方法。

'// 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 3

這裏還有一個要求。它會生成一個獨特的隨機數組。 在本例中，我使用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 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