[1] 配列を並び替えるマクロです
[2] 名簿から複数データを重複せずに抜き出します
[3] どんな大きさの名簿でも使えるバージョンです
配列を並び替えるマクロです
以下のマクロでは mydata(4) という 4 変数の配列を用意して"A", "B", "C", "D" という文字列を格納します。つまり
配列同士で無作為にデータを交換しあって、たとえば
のようにしてしまうマクロなのです。とりあえずコードを読んでみてね。
Sub ABCD無作為並び替え()
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
'配列データ (ABCD) を並べます
For i = 1 To 4
Debug.Print mydata(i);
Next i
End Sub
このマクロを実行するたびに、イミディエイトウィンドウに CDBA, ACDB などが無作為に表示されます。このマクロのポイントは
という部分です。mydata(i) と mydata(rd) の間で直接データの交換はできないので、いったん x という変数を中継して交換を実行するのです。言われてみれば簡単なんだけど、こばとは全然思いつかなかったので、こちらのサイト を参考にさせていただきましたよ。ありがとうございます。
名簿から複数データを重複せずに抜き出します
というわけで、この配列交換マクロを応用して、あるリストから無作為に複数データを抜き出すマクロを作ってみましたよ。まずは 10 個のデータを用意してください。適当なのがなければ下のデータをコピーしてね。
| 名簿 |
|---|
| 玉国 慧之輔 |
| 稲嶺 喜弘 |
| 谷河 史生 |
| 愛発 行泰 |
| 葛島 須美恵 |
| 茶円 康美 |
| 東福寺 裕吾 |
| 南畑 安枝 |
| 井土 美智江 |
| 武枝 威和夫 |
コピーしたデータはセル B2 にぺったんこと貼りつけてくださいな。
それではマクロを書いてみましょー。
Sub 複数選出A()
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 人が選び出されますよ。
どんな大きさの名簿でも使えるバージョンです
データをテーブル形式に変えておけば、より汎用性の高いマクロを作ることができます。[ホーム] ⇒ [テーブルとして書式設定]から 名簿データをテーブルに変えて、[テーブルツール] でテーブル名を「名簿」としてください。同じようにして選出データも「選出」というテーブルにしておきます。それから次のようなコードを書いてみましょう。
Sub 複数選出B()
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
マクロの実行結果は先ほどと同じようになります。
このマクロは（名簿をテーブル形式にしておけば）データ数がいくつであっても使えます。InputBox 関数なんかを使ってちょこっと改造すると、抜き出す人数もユーザーさんが入力できるようになります。掃除当番や班を決める時にも使えますよ。