【Access】無作為抽出（ランダム・サンプリング）[Rnd,VBA他]

Access

2020.06.012021.09.03

この記事にはアフィリエイト広告および広告が含まれています。

今回は、Access無作為抽出の方法をいくつかご紹介します。

無作為抽出とは、ある母集団から、ランダム（無作為）にサンプルを抽出する方法です。
使う状況でいえば、例えば企業の市場リサーチを目的としたアンケート等がありますね！

Rnd関数を使った方法
テーブル定義のオートナンバー型（ランダム）を使った方法

Rnd関数を使った方法

Rnd関数は「Rnd(引数)」で呼び出し、0以上1未満の単精度浮動小数点型の乱数（疑似乱数）を返します。今回はこのRnd関数を使用してランダム値を生成し、そしてランダム値を使って並びかえ上位から件数分抜き出し、無作為抽出を実現します。

・Rnd([引数])
引数<0：常に同じ数値をシード値として使用します。
引数>0：擬似乱数シーケンスの次の番号。
引数=0：最近生成された乱数。
省略　：擬似乱数シーケンスの次の番号。
※乱数ジェネレーターを初期化するには、Rnd を呼び出す前に、引数を指定せずに Randomize ステートメントを使用します。
引用：Rnd 関数 (Visual Basic for Applications) | Microsoft Docs

クエリから引数なしで呼び出す（失敗例）

まずRnd関数を使った失敗例からです。
単純にクエリでRnd関数を引数なしで呼び出せば無作為抽出できそうではありますが……。

テーブル情報

クエリ内容
・下部の赤枠でRnd関数を呼び出し、右上の赤枠部分で上位25件を抽出

結果

このように全レコードに同じ乱数が入ってしまいます。値がすべて同じなので上位25件ではなく1000件すべてが抽出されてしまっていますね。
これはAccessのクエリ最適化の仕様で、引数なしで関数を呼び出した場合、一度しか実行してくれないためです（引数1など固定値でもNG）。
また、Randomizeを実行していないため、乱数ジェネレーター（乱数表）が初期化されません。そのため、もう一度Accessを開きなおし同じクエリを実行した場合、同じ結果になってしまいます。

よって上記をふまえ、以下の方法をご紹介します。

方法１：Rnd関数引数あり、RandomizeのみVBA

先ほどの失敗例を踏まえ、
・Rnd関数に引数を与えることでクエリ最適化を避ける
・Randomizeを実行し、乱数表を初期化する
　こちらは逆に１度呼び出されればいいため、クエリ最適化を利用する
　（何度も呼び出されると件数が多い場合負荷がかかる）
を考慮し、作成しました。

テーブル情報

クエリ内容
・Rnd([社員NO])でランダム値を各レコードに設定
・MyRandomize()で初期化
　抽出条件（Is Null）を加えることで、表示を消しても関数呼び出しができます。

VBA：乱数表初期化

' MyRandomize()
' 乱数ジェネレータ初期化関数
Public Function MyRandomize()
    Randomize
End Function

結果

正常に無作為抽出ができました。
この方法をとる場合は、Randomizeの呼び出し漏れに注意です。レコード件数が少なく処理が遅くなってもよいということであれば、ランダム関数を呼び出す定義関数を作り、その中でRandomizeを呼び出してもいいかもしれませんね。

方法２：VBAで一括ランダム値挿入（マクロ実行）

次に、クエリでRnd関数を呼び出さず、マクロで定義関数を呼び出し、その定義関数内でRandomize＋Rnd関数を呼び出す方法です。
またマクロで実行するため、先日以下の通りご紹介した定義関数で連番もふってます。

テーブル情報
・連番とランダム値項目を用意

クエリ内容

VBA：ランダム数セット
・Randomizeで初期化
・Loopでランダム値を各レコードに設定

' SetRandom(String,String)
' ランダム値をセット
' P1:テーブル名 or クエリ名
' P2:ランダム値項目名
Public Function SetRandom(TargetName As String, TargetField As String)
    
    ' 乱数ジェネレータを初期化
    Randomize
    
    Dim rsTarget As Recordset
    Set rsTarget = CurrentDb.OpenRecordset(TargetName, dbOpenDynaset)
    
    Do Until rsTarget.EOF
        rsTarget.Edit
        rsTarget.Fields(TargetField) = Rnd()
        rsTarget.Update
        rsTarget.MoveNext
    Loop
End Function

結果