[엑셀 VBA] 일정한 범위에서 중복되지 않는 난수 배열 만들기

■  일정한 범위내에서 중복되지 않는 난수 배열 만들기 [로또번호 만드는 예제포함]

※ 아래 예제는 엑사모 latinum님이 만든 소스입니다. 

제가 필요에 의해서 블로그에 정리하는 차원에서 올린 소스이니 착오없으시길 바랍니다. 

사용자가 지정한 임의의 범위에서 필요한 개수만큼의 중복되지 않는 임의의 수를 정수형 배열로 반환하는 사용자 정의 함수입니다.예를 들어, 1,000에서 10,000 사이의 임의의 중복되지 않는 50개의 난수를 생성하고 이를 워크시트에 뿌려주려고 한다면 아래 소스를 참조하세요.

Sub dhTestMe_1() Dim i As Long Dim lngMn As Long Dim lngMx As Long Dim lngC As Long     lngMn = 1000     lngMx = 10000     lngC = 50     Range("A2").Resize(1, lngC).Value = dhUniqueRand(lngMn, lngMx, lngC) End Sub  Colored by Color Scripter

cs

만약 열방향으로 데이터를 뿌려주고 싶다면, 아래와 같이 워크시트 함수인 Transpose를 함께 이용한다.

Sub dhTestMe_2()
Dim i As Long
Dim lngMn As Long
Dim lngMx As Long
Dim lngC As Long
    lngMn = 1000
    lngMx = 10000
    lngC = 50
    Range("A2").Resize(lngC, 1).Value = Application.WorksheetFunction.Transpose(dhUniqueRand(lngMn, lngMx, lngC))
End Sub
 
Option Explicit
Function dhUniqueRand(lngMin As Long, lngMax As Long, lngCount As Long) As Long()
'*****************************************
' 사용자가 지정한 임의의 범위에서
' 필요한 개수만큼의 중복되지 않는 임의의 수를
' 정수형 배열로 반환하는 사용자 정의 함수
' 만든이 : 황기성
' 날짜 : 2017.4.21
' lngMin 최솟값
' lngMax 최댓값
' lngCount 반환할 중복되지 않는 난수의 개수
'******************************************
Dim lngNum() As Long
Dim i As Long, j As Long
Dim lngTemp As Long
Dim lngU As Long
    ' 사용자가 입력한 값의 유효성 검사
    If lngMin > lngMax Or lngCount > (lngMax - lngMin + 1) Then
        ' 유효하지 않은 경우므로 프로시저에서 빠져나감
        Exit Function
    End If
    ' 사용 가능한 모든 값을 배열에 담는다
    ReDim lngNum(0 To lngMax - lngMin)
    ' 배열을 채운다
    lngU = UBound(lngNum)
    For i = 0 To lngU
        lngNum(i) = lngMin + i
    Next
    ' 배열을 뒤섞는다
    For i = 0 To lngU
        lngTemp = lngNum(i)
        j = Int((lngMax - lngMin) * Rnd)
        lngNum(i) = lngNum(j)
        lngNum(j) = lngTemp
    Next
    ' 배열값을 반환한다
    ReDim Preserve lngNum(0 To lngCount - 1)
    dhUniqueRand = lngNum
End Function

아래는 로또 번호 만드는 예제

Sub dhTestMain()
Dim i As Long
Dim lngMn As Long
Dim lngMx As Long
Dim lngC As Long
Dim vT As Variant
Dim lngT(1 To 7) As Long
Dim p As Long
Dim m As Long
    lngMn = 1
    lngMx = 45
    lngC = 7
    
    '1에서 45까지 7개의 임의의 숫자를 추출(보너스 번호까지)
    vT = dhUniqueRand(lngMn, lngMx, lngC)
    '오름차순으로 정렬한다
    For i = 1 To 7
        lngT(i) = Application.WorksheetFunction.Small(vT, i) '오름차순으로 정렬
    Next i
Randomize
    p = Int(Rnd() * 7) + 1 '보너스 숫자를 추출하기 위해 임의의 수를 다시금 만들고
    vT = lngT
    For i = 1 To 7
        If i = p Then '해당 인덱스가 보너스 번호가 아닌 경우에
        Else
            m = m + 1 '배열에 값을 다시 넣어서
            lngT(m) = vT(i)
        End If
    Next i
    lngT(7) = vT(p) '보너스 번호
    
    Range("A2").Resize(1, lngC).Value = lngT '로또 번호를 만든다
End Sub