名簿から複数データを重複せずにランダムに抜き出すマクロ

 [1] 配列を並び替えるマクロです
 [2] 名簿から複数データを重複せずに抜き出します
 [3] どんな大きさの名簿でも使えるバージョンです

配列を並び替えるマクロです

 以下のマクロでは mydata(4) という 4 変数の配列を用意して"A", "B", "C", "D" という文字列を格納します。つまり

mydata(1)="A", mydata(2)="B", mydata(3)="C", mydata(4)="D"

 配列同士で無作為にデータを交換しあって、たとえば

mydata(1)="C", mydata(2)="A", mydata(3)="D", mydata(4)="B"

のようにしてしまうマクロなのです。とりあえずコードを読んでみてね。

 Option Base 1

 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 などが無作為に表示されます。このマクロのポイントは

x = mydata(i)

という部分です。mydata(i) と mydata(rd) の間で直接データの交換はできないので、いったん x という変数を中継して交換を実行するのです。言われてみれば簡単なんだけど、こばとは全然思いつかなかったので、こちらのサイト を参考にさせていただきましたよ。ありがとうございます。
 

名簿から複数データを重複せずに抜き出します

 というわけで、この配列交換マクロを応用して、あるリストから無作為に複数データを抜き出すマクロを作ってみましたよ。まずは 10 個のデータを用意してください。適当なのがなければ下のデータをコピーしてね。

名簿
玉国 慧之輔
稲嶺 喜弘
谷河 史生
愛発 行泰
葛島 須美恵
茶円 康美
東福寺 裕吾
南畑 安枝
井土 美智江
武枝 威和夫

 コピーしたデータはセル B2 にぺったんこと貼りつけてくださいな。
 それではマクロを書いてみましょー。

 Option Base 1

 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 人が選び出されますよ。

 ExcelVBA名簿選出ワークシート
 

どんな大きさの名簿でも使えるバージョンです

 データをテーブル形式に変えておけば、より汎用性の高いマクロを作ることができます。[ホーム] ⇒ [テーブルとして書式設定]から 名簿データをテーブルに変えて、[テーブルツール] でテーブル名を「名簿」としてください。同じようにして選出データも「選出」というテーブルにしておきます。それから次のようなコードを書いてみましょう。

 Option Base 1

 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

 マクロの実行結果は先ほどと同じようになります。

 ExcelVBA名簿選出テーブル

 このマクロは(名簿をテーブル形式にしておけば)データ数がいくつであっても使えます。InputBox 関数なんかを使ってちょこっと改造すると、抜き出す人数もユーザーさんが入力できるようになります。掃除当番や班を決める時にも使えますよ。

 ≫ VBA の技術

スポンサードリンク
末尾大型広告
末尾大型広告

コメントをどうぞ

メールアドレスが公開されることはありません。

日本語が含まれない投稿は無視されますのでご注意ください。(スパム対策)