ExcelのVBAで重複しない乱数を作る方法｜抜き取りチェックする行をランダムに選ぶ

「明細500行から10件を選んで中身を確認したい」というとき、VBAのRnd関数で行番号を10回作ると、同じ行が2回選ばれることがあります。Rndは呼ぶたびに独立して値を返すので、前に出た値を避けてはくれません。

この記事では、重複しない乱数を指定した個数だけ作る方法を2つ紹介します。そのうえで、明細から抜き取りチェックする行を選んで印を付けるマクロと、同じ結果を再現したいときの扱いをまとめます。

先に決めておくこと

コードを書く前に、次の4点を決めておきます。

• 対象の範囲：何行目から何行目か。キーが空の行やキャンセル済みの行など、除外する行はあるか
• 抜き取る件数：何件選ぶか
• 再現の要否：毎回違う結果でよいか、あとで同じ結果を出し直せる必要があるか
• 印を付ける列：既存のデータを上書きしない、空いている列

方法1：Dictionaryで重複をはじく

乱数を1つ作るたびに、既に出た値かどうかを確かめ、出ていなければ加えます。必要な個数がそろうまで繰り返します。

Function UniqueRandomsDict(minV As Long, maxV As Long, n As Long) As Variant
    Dim dict As Object, v As Long

    If n < 1 Or n > maxV - minV + 1 Then
        Err.Raise 5, , "個数が範囲の大きさを超えています。"
    End If

    Set dict = CreateObject("Scripting.Dictionary")
    Do While dict.Count < n
        v = Int((maxV - minV + 1) * Rnd) + minV
        If Not dict.Exists(v) Then dict.Add v, True
    Loop

    UniqueRandomsDict = dict.Keys   ' 0始まりの配列で返る
End Function

Sub TestDict()
    Dim result As Variant, i As Long
    Randomize
    result = UniqueRandomsDict(1, 100, 10)
    For i = LBound(result) To UBound(result)
        Debug.Print result(i)
    Next i
End Sub

コードが短く、範囲が広くて選ぶ個数が少ないとき（1〜10000から10個など）に向いています。

注意点は3つです。

• 選ぶ個数が範囲の大きさに近いと、既に出た値に当たる回数が増え、ループが長くなる
• 個数が範囲の大きさを超えると永久に終わらないため、最初のチェックは外さない
• Scripting.DictionaryはWindowsの機能です。Mac版のExcelでは使えないので、次の方法2を使う

方法2：配列をシャッフルして先頭から取る

範囲内の値をすべて配列に並べ、順番をランダムに入れ替えてから先頭のn個を取ります。並んでいる値はもともと重複しないので、取り出した値にも重複が出ません。

すべてを入れ替える必要はなく、先頭のn個分だけ入れ替えれば十分です。

Function UniqueRandomsShuffle(minV As Long, maxV As Long, n As Long) As Variant
    Dim arr() As Long, result() As Long
    Dim cnt As Long, i As Long, j As Long, tmp As Long

    cnt = maxV - minV + 1
    If n < 1 Or n > cnt Then
        Err.Raise 5, , "個数が範囲の大きさを超えています。"
    End If

    ReDim arr(1 To cnt)
    For i = 1 To cnt
        arr(i) = minV + i - 1
    Next i

    ' i番目を、i番目から最後までの中からランダムに選んだ要素と入れ替える
    For i = 1 To n
        j = Int((cnt - i + 1) * Rnd) + i
        tmp = arr(i): arr(i) = arr(j): arr(j) = tmp
    Next i

    ReDim result(1 To n)
    For i = 1 To n
        result(i) = arr(i)
    Next i
    UniqueRandomsShuffle = result   ' 1始まりの配列で返る
End Function

繰り返しの回数が必ずn回で終わり、範囲の全部を選ぶ場合（並べ替えだけしたい場合）でも速さが変わりません。Mac版でも動きます。

その代わり、範囲の大きさ分の配列を作るので、範囲が数百万といった規模になるとメモリを使います。

どちらを使うか

抜き取りチェックでは、空の行や対象外の行を除いた候補の一覧から選ぶことが多くなります。そのため、次のマクロでは方法2の考え方を使っています。

Randomizeを書く位置

Randomizeは、乱数の出発点（種）を決める命令です。

• マクロの最初に1回だけ書く：乱数を作るループの手前で呼ぶ
• ループの中には書かない：引数を省略したRandomizeはシステムタイマーの値を種にします。短い間隔で何度も呼ぶと同じ種が使われ、同じ値が続くことがある
• 書き忘れない：Randomizeを呼ばないと、Excelを起動し直すたびに同じ並びの乱数が出る

同じ結果を再現したいとき

「あとで同じ抜き取り結果を出し直して説明できるようにしたい」という場合は、種を固定します。Rndに負の値を渡した直後に、数値を指定してRandomizeを呼ぶと、同じ種から同じ並びの乱数が出ます。

Dim dummy As Single
dummy = Rnd(-1)
Randomize 12345   ' 記録しておく種の値

ただし、再現できるのは、候補の行が同じ順番・同じ件数で並んでいる場合だけです。明細を並べ替えたり、行を追加・削除したりすると、同じ種でも選ばれる行は変わります。

そのため、再現を種だけに頼らず、選ばれた行のキー（伝票番号など）そのものを記録しておくのが確実です。

明細から抜き取り行を選んで印を付けるマクロ

「明細」シートの1行目が見出し、2行目以降がデータという前提です。A列が伝票番号などのキーで、H列が空いている列とします。

実行記録を残すため、事前に「抜き取り記録」シートを作り、1行目にA:実行日時、B:種、C:候補数、D:抽出したキーの見出しを入れておきます。

Sub MarkSampleRows()
    Const SHEET_NAME As String = "明細"
    Const KEY_COL As String = "A"       ' 伝票番号など、行を特定できる列
    Const MARK_COL As String = "H"      ' 印を付ける空き列
    Const SAMPLE_COUNT As Long = 10     ' 抜き取る件数
    Const SEED As Long = 0              ' 0なら毎回違う結果。再現したいときは正の整数を指定

    Dim ws As Worksheet, logWs As Worksheet
    Dim lastRow As Long, r As Long, cnt As Long
    Dim cand() As Long, i As Long, j As Long, tmp As Long
    Dim dummy As Single, picked As String, nextRow As Long

    Set ws = ThisWorkbook.Worksheets(SHEET_NAME)
    lastRow = ws.Cells(ws.Rows.Count, KEY_COL).End(xlUp).Row
    If lastRow < 2 Then
        MsgBox "明細がありません。", vbExclamation
        Exit Sub
    End If

    ' 候補になる行番号を集める（キー列が空の行は除く）
    ReDim cand(1 To lastRow - 1)
    For r = 2 To lastRow
        If Len(CStr(ws.Cells(r, KEY_COL).Value)) > 0 Then
            cnt = cnt + 1
            cand(cnt) = r
        End If
    Next r

    If cnt < SAMPLE_COUNT Then
        MsgBox "候補が" & cnt & "行しかありません。件数を見直してください。", vbExclamation
        Exit Sub
    End If

    ' 乱数の種を決める（ここで1回だけ）
    If SEED = 0 Then
        Randomize
    Else
        dummy = Rnd(-1)
        Randomize SEED
    End If

    ' 候補の先頭からSAMPLE_COUNT個だけを入れ替える
    For i = 1 To SAMPLE_COUNT
        j = Int((cnt - i + 1) * Rnd) + i
        tmp = cand(i): cand(i) = cand(j): cand(j) = tmp
    Next i

    ' 前回の印を消してから、選んだ行に印を付ける
    ws.Range(ws.Cells(2, MARK_COL), ws.Cells(lastRow, MARK_COL)).ClearContents
    For i = 1 To SAMPLE_COUNT
        ws.Cells(cand(i), MARK_COL).Value = "抽出"
        picked = picked & CStr(ws.Cells(cand(i), KEY_COL).Value) & ","
    Next i

    ' 実行記録を残す
    Set logWs = ThisWorkbook.Worksheets("抜き取り記録")
    nextRow = logWs.Cells(logWs.Rows.Count, "A").End(xlUp).Row + 1
    logWs.Cells(nextRow, "A").Value = Now
    logWs.Cells(nextRow, "B").Value = SEED
    logWs.Cells(nextRow, "C").Value = cnt
    logWs.Cells(nextRow, "D").Value = Left(picked, Len(picked) - 1)

    MsgBox SAMPLE_COUNT & "行に印を付けました。", vbInformation
End Sub

使う手順

1. ブックを保存するか、コピーを作ってから試す（印の列は実行のたびに消して書き直す）
2. 定数のシート名・キー列・印の列・件数を、自分の明細に合わせて書き換える
3. 実行し、メッセージの件数と、印の列の「抽出」の数が一致するかを確かめる。フィルターやCOUNTIF関数で数えられる
4. 印の列でフィルターをかけ、抽出された行を順にチェックする
5. チェックの結果は印の列とは別の列に書く（次に実行したとき、印の列は消えるため）

印は数式ではなく値として書き込まれるので、シートが再計算されても選ばれた行は変わりません。

つまずきやすい点

• フィルターで隠れた行や非表示の行も候補に入る：除外したい場合は、候補を集める条件に ws.Rows(r).Hidden = False を加える
• 特定の状態の行だけを対象にしたい：候補を集める If の条件に、その列の値の判定を加える（例：ステータス列が「確定」の行だけ）
• 前回の結果を残したい：ClearContentsの行を外すか、印の列を実行ごとに変える。上書きでよいかは、運用に合わせて決める
• 並べ替えたら再現できなくなった：種ではなく、記録シートの「抽出したキー」で行を探し直す
• 用途の決まりを確かめる：Rndは暗号や抽選の公正さを証明するための乱数ではありません。監査や品質検査などで抽出方法が指定されている場合は、その指定に従ってください

選ぶ個数が少なければDictionaryで十分です。候補の一覧から選ぶ場合やMac版でも動かしたい場合は、配列をシャッフルして先頭から取る方法が扱いやすくなります。Randomizeはマクロの最初に1回だけ呼び、結果は抽出したキーとして記録しておけば、あとからの確認にも困りません。