[VBA] 複数データを重複しないでランダムに抜き出す

[VBA] 重複しないでランダムに抜き出す

 今回はあるデータセットから、複数データを 重複しないランダム に抜き出すマクロを作ってみます。まずその練習として、4変数配列を用意して"A", "B", "C", "D" という文字列を格納できる Sub プロシージャを作っておきます。

Option Base 1

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 などが無作為に表示されます。要となるのは

x = mydata(i)

という部分です。mydata(i) と mydata(rd) の間で直接データの交換はできないので、いったん x という変数を中継して交換を実行しています。言われてみれば簡単なんだけど、こばとは全然思いつかなかったので、こちらのサイト を参考にさせていただきました。どうもありがとうございます。
 
 というわけで、この配列交換プロシージャを応用して、あるリストから無作為に複数データを重複なしで抜き出すマクロを作ってみました。まずは 10 個のデータを用意してください。適当なのがなければ下のデータをコピーしてね。

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

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

[VBA] 複数データを重複なしでランダムに抜き出す

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

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

[VBA] テーブルから重複しないでランダムに抜き出す

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() の実行結果は先ほどと同じようになります。

 ExcelVBA名簿選出テーブル

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


 

コメントをどうぞ

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

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