● 重複しない乱数を発生させる ●

下の方にあるサンプルは10年以上も前に書いたコード。
もうちっと洗練させることが出来るのではないか、と思ったので改めて書いてみた。ちゃんと動くのかな?
'-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
' 機  能:重複しない乱数を発生させる
' 引  数:(i/o)NumArray … 指定範囲内の重複しない値(配列)
'         (i)  MaxNum   … 最大値
'         (i)  MinNum   … 最小値(デフォルト:0)
' 返り値:取得した値の数(NumArray配列の要素数)   異常:0
'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
Public Function GetRndNum(ByRef NumArray() As Long, ByVal MaxNum As Long, _
                          Optional ByVal MinNum As Long = 0) As Long
    '引数チェック
    If MaxNum <= MinNum Or MinNum < 0 Then Exit Function

    Dim i As Long
    Dim RndValue As Long
    Dim IsUsed() As Boolean

    '配列再確保
    ReDim NumArray(MaxNum - MinNum) As Long  '返り値となる変数
    ReDim IsUsed(MaxNum - MinNum) As Boolean 'その値が設定済みであることを保持する

    '最小値から最大値までの数値の個数(要するに返り値)
    GetRndNum = MaxNum - MinNum + 1

    '先頭から最後まで値の設定を行う
    For i = 0 To UBound(NumArray)
        Do
            '乱数生成機初期化
            Randomize
            '乱数値を取得する
            RndValue = Int(Rnd * GetRndNum)
        Loop Until (IsUsed(RndValue) = False)

        'RndValueの値は使用済み
        IsUsed(RndValue) = True

        '値設定
        NumArray(i) = RndValue + MinNum
    Next i
End Function

[動作確認用]
Private Sub Command1_Click()
    Dim Data() As Long
    Dim DataNum As Long
    Dim i As Long

    DataNum = GetRndNum(Data, 19)
    For i = 0 To DataNum - 1
        Debug.Print Data(i) & Space$(1);
    Next i
    Debug.Print ""
End Sub


はるか昔に書いたモノ。ちゃんと動くのかな?
'---------------------------------------------------------------------
' 関数名 : CreateRandNumNotTheSame
'   機能 : 重複しない乱数を発生させる
'   引数 : (in/out) RandNumArray() … 乱数を格納する配列変数
'          (in) MaxNum … 乱数の最大値
'          (in) MinNum … 乱数の初期値(デフォルト=0)
' 戻り値 : 正常 : 発生させた乱数の個数が返る、
'          エラー: -1が返る
'---------------------------------------------------------------------
Public Function CreateRandNumNotTheSame(ByRef RandNumArray() As Long, _
                                        ByVal MaxNum As Long, _
                                        ByVal Optional MinNum As Long = 0) As Long

    Dim RndMaxNum%, RndMinNum As Long     '乱数の最小値、最大値
    Dim RndRange As Long       '発生させる乱数の幅
    Dim ArrayNum As Long       '配列数
    Dim GotRndNum As Long      '発生させた乱数
    Dim i As Long              'ループ作業用変数
    Dim CheckFlag() As Boolean '数字チェック用配列変数
                               'True …数字が存在している
                               'False…数字が存在していない

    On Error GoTo ErrHandler

    If MaxNum < MinNum Then GoTo ErrHandler

    RndRange = (MaxNum - MinNum) + 1 '発生させる乱数の幅を取得
    ArrayNum = MaxNum - MinNum       '配列数を取得

    'メモリー確保
    ReDim RandNumArray(ArrayNum) As Long
    ReDim CheckFlag(ArrayNum) As Boolean
    
    'チェック変数初期化
    For i = 0 To ArrayNum
        CheckFlag(i) = False  '数字が存在していないにセット
    Next i
    
    '乱数発生 & 格納
    For i = 0 To ArrayNum
        Do
            Randomize  '乱数ジェネレータ初期化
            '指定範囲内での乱数で発生させる
            GotRndNum = Int(Rnd * RndRange) + MinNum
        Loop Until CheckFlag(GotRndNum - MinNum) = False

        '数字が存在しているにセット
        CheckFlag(GotRndNum - MinNum) = True

        '数を格納
        RandNumArray(i) = GotRndNum
    Next i

    CreateRandNumNotTheSame = ArrayNum
NormalExit:
    Exit Function
    
ErrHandler:
    CreateRandNumNotTheSame = -1
End Function

[動作確認用]
Private Sub Command1_Click()

    Dim RandNum() As Long
    Dim GotRndNum As Long
    Dim i As Long

    'GotRndNum = CreateRandNumNotTheSame(RandNum(), 20, 1)
    'GotRndNum = CreateRandNumNotTheSame(RandNum(), 20)
    GotRndNum = CreateRandNumNotTheSame(RandNum(), 20, 10)

    For i = 0 To GotRndNum
        Debug.Print RandNum(i) & ",";
    Next i
    Debug.Print ""
End Sub

戻る