VBA

【VBA】乱数生成のロジック(メカニズム)といろいろな乱数処理の方法

記事内に商品プロモーションを含む場合があります
このページでわかること

VBAで様々な条件で乱数を返すコードを公開します。

一覧
  • 乱数生成のための最低限の関数等の知識
  • 関数を利用するためのロジック
  • コード(乱数生成)
  • コード(重複なし乱数生成)
  • コード(日付乱数生成)
  • コード(重複なし日付乱数生成)

こんにちは、hokkyokunです。
乱数生成プログラムについてまとめました。

VBAにはRnd関数があるのですが、これは0~1の間の数値を返す関数で、
そのままほしい乱数が取れるというものではありません。
それなりにプログラムを作らないとだめです。

今回は、乱数を取得するために必要な最低限の関数等と
それらの関数を使って乱数を得る方法(ロジック)、
また、数値、日付の乱数を得るプログラムを、重複ありなしで作成しました。

何かの業務や統計処理で使えたら幸いです。

乱数を返す方法

「VBA 乱数」で検索すると記事がたくさん出てきます。
ただ、なんの関数を使えばいいかや
その関数を使って実際の乱数を作る方法(ロジック)はよく出てくるのですが、
その方法(ロジック)について詳しく説明しているサイトがあまり見当たりませんでした。
あと、ただ乱数を作りたいだけなのに必要以上に細かく関数の説明をしたり。。。

乱数を発生させる関数、ステートメント

まずはこれだけ覚えればいいと思います。

  • Rnd(関数)
  • Randomize(ステートメント)

Rndで0~1の間の値を返します。
公式ドキュメントには記載が見当たらなかったのですが、
実際に使うと小数点第6~7位(8位もある?)の数値を返します。

この乱数は乱数表があらかじめ決まっていて乱数表の順番通りに返すようです。
その乱数表を管理する値としてシード値というものがあるようです。

Randomaizeを使うことでシード値を初期化するので、
処理前にRandomizeをいれておくと安心できると思います。

試しにこれらをコードで書いてみました。
下記のような値が返ってきます。

Function rand()
    Randomize
    Debug.Print Rnd
    '>> 0.495711
End Function

関数はこれだけで大丈夫です。
後の小難しい話はとりあえず、使えてからでいいと思います。

乱数を得る方法(ロジック)

ではこの0~1の値でどうやって乱数をつくるかですが、
いくつかのサイトでこれについて解説をしています。
以下のように記述しているサイトが多いように思います。

Int((最大値-最小値+1)* Rnd +最小値))
Intは小数点以下を切り捨てるために使います。

自分はこれを最初みてなんのこっちゃと思いました。
が、分解したり、実際に計算してみるとなんのことはないです。

細分化してみます。
ある範囲からある範囲までの数値から乱数を発生させるということは、

  1. X個の数値のなかから、ランダムに一つ選択するということです。
  2. 1.は 0~(X-1)から数値を一つ選択すると言い換えられます。
  3. 2.に最小値を足して、(最小値+0)~(最小値+(X-1))から数値を一つ発生させます。

ということです。まだわからないと思うので、
実例を見ながら考えていきたいと思います。

2~8の範囲で整数の乱数を発生させる場合

2,3,4,5,6,7,8の7個の値から
ランダムに値を選択するということになります。
これが公式の前半部分(最大値-最小値+1)にあたります。
つまり、(8-2+1)=7 です。
Xが計算できました。

次に中間部分までの(最大値-最小値+1)* Rnd です。
Rndをかけていますが、これは試しに計算してみましょう。
最大値クラス(Rnd=0.999とした場合):(8-2+1)* 0.999 = 6.993
最小値クラス(Rnd=0.001とした場合):(8-2+1)* 0.001 = 0.007
となります。

Intによって小数点切り捨てなので0~6の間に集約されます。
0を含めた整数の数は7個です。
0~(X-1)の範囲で数値を一つ選択する。までが計算できました。

これに後半の +最小値 を足すことで当初の目的の範囲に数値を押し上げることができます。
0~6に2を足すので、2~8ということになります。

Intは途中までかかっている場合でも
最後までかかっている場合でも結果は変わりません。

よって、公式はInt((最大値-最小値+1)* Rnd) +最小値 でも動きます。
(自分が試した範囲で動かないことはないし、理論的にも正しいと思いますが、
動かない場合があったら教えてください。)

乱数を生成するプログラム

長々と説明すみません。
プログラムですが、以下の通りです。

目的によって以下の形にしました。

ベーシック:範囲、回数を設定して配列に返す
重複なし:範囲、回数を設定し、重複が生じない配列を返す
日付:範囲、回数を設定し、日付を配列で返す。
日付(重複なし):範囲、回数を設定し、重複がない日付を配列で返す。

ベーシック乱数配列(範囲、回数を指定。配列を返す。)

Function get_Random(times_, min_, max_)
    Dim i As Long
    Dim arrs() As Variant
    If min_ > max_ Then
        MsgBox ("最小値 > 最大値になっています。")
        get_Random = Array()
        Exit Function
    End If
    Randomize
    For i = 1 To times_
        ReDim Preserve arrs(i - 1)
        arrs(i - 1) = Int((max_ - min_ + 1) * Rnd + min_)
    Next i
    get_Random = arrs
End Function

引数に(反復回数、最小値、最大値)を設定することで
配列として返してくれます。

最小値>最大値でも動くのは動くのですが、
気持ち悪いのでプログラムを中断させてます。
(重複なしプログラム等ほかのプログラムは逆になると値がおかしくなります。)

中断させた際は空の配列を返します。
ちなみに空の配列かどうかはUbound(配列)でわかります(空なら-1)

*上記の空の配列判定はこのページで紹介しているコードに対してです。
一般的にはUbound(配列)でエラーが起こる場合があります。
(このエラーを利用して空かどうか判定はできますが、また別の話。。。)

重複なしの乱数配列

Function get_unique_Random(times_, min_, max_)
    Dim i As Long
    Dim arr, arrs() As Variant
    Dim rndNum As Long
    Dim fil_arr As Variant
    Dim flg As Boolean
    
    '最大値>最小値で入力してもらいたいため
    If min_ > max_ Then
        MsgBox ("最小値 > 最大値になっています。")
        get_unique_Random = Array()
        Exit Function
    End If
    
    'エラー回避 一度使った数値は使えないので、反復のほうが多いと無限ループになる。
    If max_ - min_ + 1 < times_ Then
        MsgBox ("重複なしを作るには反復回数が多すぎます。設定を確認してください")
        get_unique_Random = Array()
        Exit Function
    End If
    
    Randomize
    For i = 1 To times_
        ReDim Preserve arrs(i - 1)
        
        '乱数を取得。その際、重複がある場合は乱数を取り直す。
        Do
            rndNum = Int((max_ - min_ + 1) * Rnd + min_)
            
            '配列内をfor文で要素を取り出し、完全一致するものがあるかどうか判定
            '完全一致する⇒flg=Trueとなり、もう一度乱数を取り直す。
            flg = False
            For Each arr In arrs
                If rndNum = arr Then
                    flg = True
                    Exit For
                End If
            Next
        Loop While flg = True
        arrs(i - 1) = rndNum
    Next i
    get_unique_Random = arrs
    
End Function

エラー回避したりしてるので、ちょっと長くなっちゃいました。

重複なしの乱数なので、
反復回数のほうが多いと使える数字がなくなって無限ループします。
それを回避するためエラー回避のプログラムを忍ばせています。
15~20行あたり

配列に既に同じ要素が存在するかを判定するプログラムですが、
配列内をfor文で一つ一つ要素を取り出し、存在するかどうかを確認しています。
30~39行あたりです。

日付の乱数配列

Function get_Random_date(times_, start_date, end_date)
    Dim rndNum As Long '乱数
    Dim date_Diff As Long '日付の差分
    Dim arrs() As Variant '乱数を格納する配列
    Dim i As Long 'for文で使用するインデックス数値
    
    '逆だと値がおかしくなるため
    If start_date > end_date Then
        MsgBox ("開始日 > 終了日になっています。")
        get_Random_date = Array()
        Exit Function
    End If
    
    'start_dateとend_dateの差分
    date_Diff = DateDiff("d", start_date, end_date)
    
    Randomize
    For i = 1 To times_
        ReDim Preserve arrs(i - 1)
        rndNum = Int((date_Diff + 1) * Rnd) '乱数生成
        '開始日に生成した乱数分を足す
        arrs(i - 1) = DateAdd("d", rndNum, start_date)
    Next i
    get_Random_date = arrs
End Function

作り始めたら思ったより簡単でした。

DateDiff関数でstart_date(=開始日)、end_date(=終了日)の差分を計算させます。
その差+1にRndかけて乱数を生成します。

上記でロジックを解説したように

  • X個のなかから数値を一つ選ぶ
  • 0~(X-1)のなかから数値を一つ選ぶ
  • 最低値で底上げして0+最低値~(X-1)+最低値から数字を選ぶ

ということをやるのですが、今回は最低値が0(=開始日)なので最低値は足しません。

こういうとき、公式(メカニズム)を理解していると応用が利きますね。

重複なしの日付の乱数配列

Function get_unique_Random_date(times_, start_date, end_date)
    Dim rndNum As Long '乱数
    Dim rndDate As Date '開始日に乱数分足した日数
    Dim date_Diff As Long '日付の差分
    Dim arr, arrs() As Variant '乱数を格納する配列
    Dim i As Long 'for文で使用するインデックス数値
    Dim flg As Boolean '配列内に重複する要素があるかどうかブール型で取得
    
    '逆だと値がおかしくなるため
    If start_date > end_date Then
        MsgBox ("開始日 > 終了日になっています。")
        get_unique_Random_date = Array()
        Exit Function
    End If
    
    'start_dateとend_dateの差分
    date_Diff = DateDiff("d", start_date, end_date)
    
    'エラー回避 一度使った数値は使えないので、反復のほうが多いと無限ループになる。
    If date_Diff + 1 < times_ Then
        MsgBox ("重複なしを作るには反復回数が多すぎます。設定を確認してください")
        get_unique_Random_date = Array()
        Exit Function
    End If
    
    Randomize
    For i = 1 To times_
        ReDim Preserve arrs(i - 1)

        '乱数を取得。その際、重複がある場合は乱数を取り直す。
        Do
            rndNum = Int((date_Diff + 1) * Rnd) '乱数生成
            rndDate = DateAdd("d", rndNum, start_date) '開始日に乱数分足す
            
            '配列内をfor文で要素を取り出し、完全一致するものがあるかどうか判定
            '完全一致する⇒flg=Trueとなり、もう一度乱数を取り直す。
            flg = False
            For Each arr In arrs
                If rndDate = arr Then
                    flg = True
                    Exit For
                End If
            Next
        Loop While flg = True
        arrs(i - 1) = rndDate
    Next i
    get_unique_Random_date = arrs
End Function

最後は応用でした。

特に新しい手法は使っていません。
今までの組み合わせでプログラムは動いています。

まとめと応用展開の例

いかがでしょうか。

これらをベースに実務での応用例としては

  • Dictionaryにて、keyに番号、Valueに文字列などを入れて、文字列もランダムに選択させる
  • なんらかのテストを行う際の乱数を生成
  • 重複なしの日付の乱数で当番をランダムで作る(曜日などをさらに絞る必要があるかもしれません)

ざっと思ったのはこんな感じですが、
機械学習をしなくても乱数は結構使えるんじゃないかと最近思いました。

ではでは。