はじめに
テスト用データやサンプルデータを作るとき、あらかじめ用意した候補から品番・工程・担当などをランダムに組み合わせたいことがあります。候補数がすべて同じなら単純ですが、列ごとに候補数が異なる表では、空欄まで抽選対象にすると結果に空白が混ざります。
Excel VBAを使えば、列ごとに空欄ではない候補だけを集め、その候補数に合わせてランダムに値を選べます。この記事では、候補数が異なる複数のワードリストから、指定した件数のランダムデータを自動生成する方法を解説します。
今回作るランダムデータ
「候補」シートに次のような表があるものとします。列ごとに候補数が違っていても構いません。
| 品番 | 工程 | 担当 |
|---|---|---|
| A-01 | 加工 | 田中 |
| A-02 | 検査 | 佐藤 |
| A-03 | 梱包 | |
| A-04 |
この例では、品番は4件、工程は3件、担当は2件です。候補数が同じ列でも同じコードを使えます。さらに「候補」シートのE2セルへ作成したいデータ件数を入力します。
例えばE2へ「5」と入力してマクロを実行すると、「結果」シートへ次のようなデータを5行作成します。
| 品番 | 工程 | 担当 |
|---|---|---|
| A-03 | 検査 | 田中 |
| A-01 | 加工 | 佐藤 |
| A-04 | 梱包 | 佐藤 |
| A-02 | 加工 | 田中 |
| A-03 | 検査 | 佐藤 |
組み合わせは実行するたびに変わります。同じ候補が複数行で選ばれることもあります。この記事では「候補からランダムに選ぶ」ことを扱い、同じ値を二度使わない抽選は対象にしません。
事前準備
Excelブックに「候補」と「結果」という2つのワークシートを用意します。「候補」シートは1行目を見出し、2行目以降を候補データとします。候補列はA列から右方向へ連続して配置してください。
作成件数は「候補」シートのE2セルへ正の整数で入力します。候補表がA～C列の場合、E列は候補表の外なので、そのまま件数入力に使えます。候補列を増やす場合は、DataCountCellを候補表と重ならないセルへ変更してください。
コードはVisual Basic Editor（VBE）の標準モジュールへ貼り付けます。「結果」シートは出力専用として扱います。マクロ実行時にシート内の既存内容を消去してから結果を書き込みます。残したい内容がある場合は、出力専用シートを別に用意してください。
VBAコード
Option Explicit
Sub CreateRandomData()
Const CandidateSheetName As String = "候補"
Const ResultSheetName As String = "結果"
Const HeaderRow As Long = 1
Const CandidateStartRow As Long = 2
Const DataCountCell As String = "E2"
Const ResultStartCell As String = "A2"
Dim wsCandidate As Worksheet
Dim wsResult As Worksheet
Dim lastColumn As Long
Dim lastRow As Long
Dim dataCount As Long
Dim dataCountValue As Variant
Dim outputRow As Long
Dim candidateRow As Long
Dim col As Long
Dim randomIndex As Long
Dim candidates As Collection
Dim candidateValue As Variant
Dim headerValue As Variant
Dim headerData As Variant
Dim resultData() As Variant
Set wsCandidate = ThisWorkbook.Worksheets(CandidateSheetName)
Set wsResult = ThisWorkbook.Worksheets(ResultSheetName)
lastColumn = wsCandidate.Cells(HeaderRow, wsCandidate.Columns.Count) _
.End(xlToLeft).Column
If wsCandidate.Range(DataCountCell).Column <= lastColumn _
And wsCandidate.Range(DataCountCell).Row >= CandidateStartRow Then
MsgBox "作成件数セルが候補表と重なっています。" _
& vbCrLf & "DataCountCellを候補表の外へ変更してください。", vbExclamation
Exit Sub
End If
dataCountValue = wsCandidate.Range(DataCountCell).Value2
If IsError(dataCountValue) Then
MsgBox "作成件数のセルにエラーがあります。", vbExclamation
Exit Sub
End If
If Not IsNumeric(dataCountValue) Then
MsgBox "作成件数には正の整数を入力してください。", vbExclamation
Exit Sub
End If
If CDbl(dataCountValue) < 1 _
Or CDbl(dataCountValue) <> Fix(CDbl(dataCountValue)) Then
MsgBox "作成件数には正の整数を入力してください。", vbExclamation
Exit Sub
End If
If CDbl(dataCountValue) > _
wsResult.Rows.Count - wsResult.Range(ResultStartCell).Row + 1 Then
MsgBox "作成件数が結果シートへ出力できる行数を超えています。", vbExclamation
Exit Sub
End If
dataCount = CLng(dataCountValue)
ReDim resultData(1 To dataCount, 1 To lastColumn)
Randomize
For col = 1 To lastColumn
headerValue = wsCandidate.Cells(HeaderRow, col).Value2
If IsError(headerValue) Then
MsgBox "見出しにエラーがあります。列番号: " & col, vbExclamation
Exit Sub
End If
If Len(CStr(headerValue)) = 0 Then
MsgBox "見出しが空欄の列があります。列番号: " & col, vbExclamation
Exit Sub
End If
lastRow = wsCandidate.Cells(wsCandidate.Rows.Count, col) _
.End(xlUp).Row
Set candidates = New Collection
If lastRow >= CandidateStartRow Then
For candidateRow = CandidateStartRow To lastRow
candidateValue = wsCandidate.Cells(candidateRow, col).Value2
If IsError(candidateValue) Then
MsgBox "候補リストにエラー値があります。" _
& vbCrLf & "列: " & CStr(headerValue) _
& " / 行: " & candidateRow, vbExclamation
Exit Sub
End If
If Len(CStr(candidateValue)) > 0 Then
candidates.Add candidateValue
End If
Next candidateRow
End If
If candidates.Count = 0 Then
MsgBox "候補が1件もない列があります: " _
& CStr(headerValue), vbExclamation
Exit Sub
End If
For outputRow = 1 To dataCount
randomIndex = Int(candidates.Count * Rnd) + 1
resultData(outputRow, col) = candidates(randomIndex)
Next outputRow
Next col
wsResult.Cells.ClearContents
headerData = wsCandidate.Range( _
wsCandidate.Cells(HeaderRow, 1), _
wsCandidate.Cells(HeaderRow, lastColumn) _
).Value2
wsResult.Cells(1, 1).Resize(1, lastColumn).Value2 = headerData
wsResult.Range(ResultStartCell) _
.Resize(dataCount, lastColumn).Value2 = resultData
MsgBox dataCount & "件のランダムデータを作成しました。", vbInformation
End Subコードのポイント
列ごとに候補だけをCollectionへ集める
候補数が異なる表では、表全体の最終行を1つだけ使いません。各列でEnd(xlUp)により最後のデータ行を確認し、2行目から順に読み取ります。
Collectionは、複数の値を順番にまとめて保持できるVBAのオブジェクトです。空欄ではない値だけをCollectionへ追加するため、列ごとに候補数が違っても実在する候補だけを抽選できます。途中の空欄も候補へ追加されません。
RandomizeとRndで候補番号を決める
Randomizeは乱数ジェネレーターを初期化し、Rndは0以上1未満の値を返します。候補数をcandidates.Countで取得し、次の式でCollectionの1番目から最後までの番号を作ります。
randomIndex = Int(candidates.Count * Rnd) + 1例えば候補が4件なら、randomIndexは1～4のいずれかになります。各出力行・各列でこの処理を行い、選ばれた値を二次元配列resultDataへ格納します。
候補がない列や不正な件数は処理を止める
候補がない列や、空欄・文字列・0以下・小数の作成件数では処理を続けられません。
コードでは作成件数、見出し、候補を確認し、不正な場合はメッセージを表示して終了します。候補セルにExcelのエラー値がある場合も停止します。
結果は配列にためて一括出力する
抽選結果はセルへ1件ずつ書き込まず、resultDataへためてからResizeで確保した範囲へ一括出力します。作成件数と候補列数に合わせて出力範囲が決まるため、候補列を増減しても同じ考え方で処理できます。
実行手順
- 「候補」シートの1行目へ見出しを入力します。
- 2行目以降へ列ごとの候補を入力します。列ごとに候補数が違っていても構いません。
- 「候補」シートのE2へ作成件数を正の整数で入力します。
- 「結果」シートを作成します。
- 標準モジュールへコードを貼り付けます。
CreateRandomDataを実行します。- 「結果」シートに指定件数のデータが作成されたことを確認します。
候補を追加・削除した後も、同じマクロを再実行すれば現在の候補からデータを作り直せます。
よくある失敗
作成件数セルが候補表と重なっている
この例では作成件数をE2へ入力します。候補列をE列まで増やした場合、E2は候補データと重なります。コードは重なりを検出すると停止するため、DataCountCellを候補表の外にあるセルへ変更してから実行してください。
見出し行の途中に空欄がある
コードは1行目の右端までを候補列として扱います。その途中に見出しがない列があると、どのデータを生成する列なのか判断できないため処理を停止します。候補列はA列から右方向へ連続して配置します。
候補の重複を禁止したい
このコードは各行を独立して抽選するため、同じ候補が複数回選ばれることがあります。「一度選んだ候補は次に使わない」という抽選は、候補を削除しながら選ぶなど別の処理が必要です。この記事の対象は、候補の再利用を許可したランダムデータ生成です。
まとめ
Excel VBAで列ごとに候補数が異なるワードリストを扱う場合は、列ごとに空欄ではない候補だけを集め、その候補数に合わせてランダムな番号を選ぶと安全にデータを生成できます。
この方法なら、候補数をそろえるために表へダミーデータを追加する必要はありません。作成件数、見出し、候補の有無を確認してから抽選し、結果を配列へためて一括出力することで、候補列や作成件数が変わっても使いやすい処理になります。
関連記事
