[땡큐엑셀vba & 엑셀매크로] 중복없는 난수표

 

 

 

'http://tip.daum.net/question/97566847
'
'무작위 숫자 추출 방법?
'감사합니다.
'1부터 27까지의 숫자를 가지고
'무작위로 불규칙하게
'매번 다른 내용의 일련의 난수표를 만들고자합니다.
'예를 들면,
'1회차 : 13, 7, 27, 24, 14, 19......
'2회차 : 22. 3, 18, 22, 5,......식으로
'3회차 : (1부터 27까지의 무질서한 숫자 배열)형태입니다.
'어떤 방식이 있는지요?


'
'source by 땡큐엑셀vba & 엑셀vba
'
'중복없는
Sub 무작위수()

    Dim D As Object
    'Dim v범위
    Dim 최소값 As Integer
    Dim 최대값 As Integer
    Dim 중복허용여부 As String
    Dim 갯수 As Integer
    Dim 배열1() As Integer
    
    
    최소값 = Range("B1")
    최대값 = Range("B2")
    중복허용여부 = Range("B3")
    갯수 = 최대값 - 최소값 + 1
    
    
    'v범위 = Selection
    
    
    'D:E열 클리어
    Range("10:10").Clear
    
    '화면갱신 중지
    Application.ScreenUpdating = False
    
    
    '딕셔너리 선언
    'Set D = CreateObject("Scripting.Dictionary")
    
    '난수 발생기를 초기화 합니다
    Randomize
    
    
    '배열에 범위값 할당
    For i = 0 To 최대값 - 최소값
        
        ReDim Preserve 배열1(i)
        배열1(i) = 최소값 + i
        
        DoEvents
        
    Next i
    
    
    
    
    

    
    '랜던하게 숫자선택
    cnt = 갯수 - 1
    Do

        k = Int(Application.WorksheetFunction.RandBetween(0, cnt))
        
        'strA = strA & "," & 배열1(k)
        tmp = 배열1(cnt)
        배열1(cnt) = 배열1(k)
        배열1(k) = tmp

        cnt = cnt - 1

        DoEvents
           
    Loop Until cnt < 0
    
    
    '출력
    rSize = UBound(배열1, 1) + 1
    Range("C1").Resize(rSize, 1) = Application.Transpose(배열1)
    
    
    
    '출력
'    Dim key As Variant
'    j = 1
'    For Each v In 배열1
'        Cells(j, "J") = v
'        j = j + 1
'    Next
    
    
    '화면 갱신 재계
    Application.ScreenUpdating = True
    
    
    MsgBox "완료되었습니다.", vbInformation, "땡큐엑셀vba & 엑셀매크로"
End Sub

 

중복없는난수표-ReDim_Preserve_Randomize_DoEvents_RandBetween_Resize_Transpose-땡큐엑셀vba.xlsm

0.05MB