비 반복 난수 생성기?

Question

사례가 숫자 인 사례 문을 통해 질문을 선택하는 응용 프로그램 (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

는 나는이 작업을했다, 당신이 대답을 볼 수 있지만 내 인터넷 연결을 잃었습니다. 어쨌든 여기에 또 다른 방법이 있습니다.

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

또 다른 테이크입니다. 고유 한 무작위 long의 배열을 생성합니다. 이 예제에서는 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