[VBA] 重複しないでランダムに抜き出す
今回はあるデータセットから、複数データを 重複しない で ランダム に抜き出すマクロを作ってみます。まずその練習として、4変数配列を用意して"A", "B", "C", "D" という文字列を格納できる Sub プロシージャを作っておきます。
Sub Sorting()
Dim i As Integer, rd As Integer
Dim x As String
Dim mydata(4) As String
mydata(1) = "A"
mydata(2) = "B"
mydata(3) = "C"
mydata(4) = "D"
For i = 1 To 4
Randomize
'1～ 4の整数を得ます
rd = Int(4 * RND + 1)
'xに元のデータを保存しておきます
x = mydata(i)
'配列データを他の配列データと交換します
mydata(i) = mydata(rd)
'保存しておいたデータを交換先に入れます
mydata(rd) = x
Next i
'配列データを並べます
For i = 1 To 4
Debug.Print mydata(i);
Next i
End Sub
Sorting() を実行するたびに、イミディエイトウィンドウに CDBA, ACDB などが無作為に表示されます。要となるのは
という部分です。mydata(i) と mydata(rd) の間で直接データの交換はできないので、いったん x という変数を中継して交換を実行しています。言われてみれば簡単なんだけど、こばとは全然思いつかなかったので、こちらのサイト を参考にさせていただきました。どうもありがとうございます。
というわけで、この配列交換プロシージャを応用して、あるリストから無作為に複数データを重複なしで抜き出すマクロを作ってみました。まずは 10 個のデータを用意してください。適当なのがなければ下のデータをコピーしてね。
| 名簿 |
|---|
| 玉国 慧之輔 |
| 稲嶺 喜弘 |
| 谷河 史生 |
| 愛発 行泰 |
| 葛島 須美恵 |
| 茶円 康美 |
| 東福寺 裕吾 |
| 南畑 安枝 |
| 井土 美智江 |
| 武枝 威和夫 |
コピーしたデータはセル B2 にぺったんこと貼りつけてくださいな。
それではマクロを書いてみましょう。
Option Base 1
Sub Rondom_choice()
Dim i As Integer, rd As Integer
Dim x As String
'10 個の要素をもつ配列を文字列型で宣言しておきます
Dim mydata(10) As String
'B3 から B12 のデータを配列に入れます
For i = 1 To 10
mydata(i) = ActiveSheet.Cells(i + 2, 2)
Next i
'配列データを無作為に交換します
For i = 1 To 10
Randomize
rd = Int(10 * RND + 1)
x = mydata(i)
mydata(i) = mydata(rd)
mydata(rd) = x
Next i
'D3～D5 に mydata(1)～mydata(3)を書き込みます
For i = 3 To 5
ActiveSheet.Cells(i, 4) = mydata(i)
Next i
End Sub
マクロを実行すると下の図のようにランダムに 3 人が選び出されますよ。
データをテーブル形式に変えておけば、より汎用性の高いマクロを作ることができます。[ホーム] ⇒ [テーブルとして書式設定]から 名簿データをテーブルに変えて、[テーブルツール] でテーブル名を「名簿」としてください。同じようにして選出データも「選出」というテーブルにしておきます。それから次のようなコードを書いてみましょう。
Option Base 1
Sub Rondom_choice_table()
Dim i As Integer, ct As Integer, rd As Integer
Dim x As String
Dim mylist As ListObject
Dim outrange As Range
Dim mydata() As String
Set mylist = ActiveSheet.ListObjects("名簿")
Set listrange = ActiveSheet.ListObjects("名簿").DataBodyRange
Set outrange = ActiveSheet.ListObjects("選出").DataBodyRange
'名簿のデータ数を数えます
ct = mylist.ListRows.Count
'配列の要素数を決めます
ReDim mydata(ct)
'配列に名簿のデータを放り込みます
For i = 1 To ct
mydata(i) = listrange.Cells(i, 1)
Next i
'配列データをシャッフルします
For i = 1 To ct
Randomize
rd = Int(ct * RND + 1)
x = mydata(i)
mydata(i) = mydata(rd)
mydata(rd) = x
Next i
For i = 1 To 3
outrange.Cells(i, 1) = mydata(i)
Next i
End Sub
Rondom_choice_table() の実行結果は先ほどと同じようになります。
Rondom_choice_table() は（名簿をテーブル形式にしておけば）データ数がいくつであっても使えます。InputBox 関数なんかを使ってちょこっと改造すると、抜き出す人数もユーザーさんが入力できるようになります。掃除当番や班を決める時にも使えますよ。
