vba 非重复随机数生成器？
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/7542617/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Non-repeating random number generator?
提问by Mark Kramer
I created a trivia game using visual basic for applications (Excel) that chooses questions by going through a case statement where the cases are numbers. I have the program randomly select a number from 1 to the max amount of questions there are. Using this method, the game repeats questions.
我使用 Visual Basic for Applications (Excel) 创建了一个琐事游戏，该游戏通过通过案例陈述来选择问题，其中案例是数字。我让程序从 1 到最大问题数量中随机选择一个数字。使用这种方法，游戏会重复问题。
Is there a way to make something that generates numbers randomly (different results every time) and doesn't repeat a number more than once? And after it's gone through all the numbers it needs to execute a certain code. (I'll put in code that ends the game and displays the number of questions they got right and got wrong)
有没有办法让一些东西随机生成数字（每次都有不同的结果）并且不会多次重复一个数字？在遍历完所有数字后，它需要执行某个代码。（我将输入结束游戏并显示他们正确和错误的问题数量的代码）
I thought of a few different ways to do this, however I couldn't even begin to think of what the syntax might be.
我想到了几种不同的方法来做到这一点，但是我什至无法开始考虑语法可能是什么。
回答by
Sounds like you need an Array Shuffler!
听起来您需要一个 Array Shuffler！
Check out the below link - http://www.cpearson.com/excel/ShuffleArray.aspx
查看以下链接 - 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
回答by aevanko
Here's yet another take. It generates an array of unique, random longs. In this example, I use 1 to 100. It does this by using the collection object. Then you can just do a normal loop through each array element in qArray without the need to randomize more than once.
这是另一个问题。它生成一个唯一的随机长数组。在本例中，我使用 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
回答by Reafidy
I see you have an answer, I was working on this but lost my internet connection. Anyway here is another method.
我看到你有一个答案，我正在研究这个，但失去了我的互联网连接。无论如何，这是另一种方法。
'// 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
回答by u3397819
For whatever it's worth here is my stab at this question. This one uses a boolean function instead of numerical arrays. It's very simple yet very fast. The advantage of it, which I'm not saying is perfect, is an effective solution for numbers in a long range because you only ever check the numbers you have already picked and saved and don't need a potentially large array to hold the values you have rejected so it won't cause memory problems because of the size of the array.
无论这里的价值是什么，我都在尝试解决这个问题。这个使用布尔函数而不是数值数组。它非常简单但非常快。我并不是说它的优点是完美的，它是一个有效的长范围数字解决方案，因为你只需要检查你已经选择和保存的数字，不需要一个潜在的大数组来保存这些值您已拒绝，因此不会因为数组的大小而导致内存问题。
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
