非重复随机数发生器？

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