[ExcelVBA] n人中m人が当選するくじ その２

>Blog Top Page >[ExcelVBA] Top Page >[ExcelVBA] プログラミング問題一覧

■お題
n人中m人が当選するくじ除(問題出典：どう書く？org)
- 問題詳細 -

n人の中から公平にm人を選ぶ、くじ引きプログラムを作ってください。

■解答例
□Collectionオブジェクトを使ってみる
シャッフルするためにあらためてコードを書くなんてめんどくさいですね。
Collectionオブジェクトなら、.Countの数を上限に乱数で要素を選択して.Removeで要素を削除しての繰り返しでよさそうですね。

では、コードです。
モジュール名：SubModule

Option Explicit

Function lot(n As Integer, m As Integer) As Variant
    Randomize
    
    Dim list As New Collection
    Dim i As Integer
  
    For i = 1 To n
        list.Add i
    Next
    
    Dim result() As variant, r As Integer
    ReDim result(m - 1)
    
    For i = 0 To m - 1
        r = Int(Rnd() * list.Count) + 1
        result(i) = list.Item(r)
        list.Remove (r)
    Next
    
    lot = result
End Function

３行目：引数 n…参加者全員の数を指定、m…選ばれる人数を指定
４行目：乱数のシードを変更する。Randomize(Number) Numberは省略可。省略時、時刻からシード値を取得。
６行目：変数 list･･･参加者の人数分値を用意しておく。
７行目：変数 i･･･For文で使用。

９行目～１１行目：人数文、Collectionオブジェクトに追加する

１３行目：変数 result･･･当選者の番号を格納するよう
            変数 r･･･乱数を格納するよう
１４行目：result配列の要素を確定する
１７行目：乱数を生成する。ただし、Collectionオブジェクトの要素は１から始まるので１以上オブジェクト.Count以下で生成。
１８行目：乱数の値を元にCollectionオブジェクトの値を当選者としてresult変数に格納する
１９行目：.removeメソッドで削除する
２０行目：繰り返し
２２行目：返り値としてresult配列を返す



実際にこんな感じで使う

モジュール名：MainModule

Option Explicit

Sub main()
    Dim result As Variant
    result = lot(10, 3)
    
    Dim i As Integer
    For i = 0 To UBound(result)
        Debug.Print result(i)
    Next
    
    Debug.Print "-------------"
End Sub

実行結果

2 
 10 
 1 
-------------
 2 
 4 
 8 
-------------
 2 
 9 
 7 
-------------
 5 
 9 
 3 
--------------

>Blog Top Page >[ExcelVBA] Top Page >[ExcelVBA] プログラミング問題一覧