VBA抽選ツール「ロッカーの位置を決める君」の開発③

2024年12月5日 14:24

　40人分の苗字一覧の中から1人の苗字を抜き出してC9セルに表示するところまではできました。次は、こうして抽選で選ばれた人を順番に1番ロッカー、2番ロッカーとロッカーを割り当てていきます。

当選した人を順番にロッカーを割り当てる

　Excelの「抽選」シートのK列とL列にロッカー番号とそのロッカーを使う人の名前を入れるように表を作ります。この表に1番から順番に当選した人の苗字を入力するようにしていきたいですね。

　これは全開の記事で書いた通り、rd = WorksheetFunction.RandBetween(1, ninzu)で選んだ数字の右隣のセルにある苗字を取り出してnameという変数に入れているので、これをL6セルにも入れればいいだけなのでさほど難しくありません。C9セルに当選者を表示するのと同じ要領で
と付け加えればOKです。　

2番ロッカーの人を決める

　では、次に2番ロッカーの人を決めていきましょう。「なんだ、簡単簡単。また同じく40人の中から一人を選べばいいよね～」というわけにはいきませんよね。なぜなら確率的には少ないとしても、すでに1番ロッカーに決まった藤井さんがまた選ばれてしまう可能性があるからです。ですので、2番ロッカーの人を選ぶときには1番ロッカーに決まった人を除いて、39人の中から一人を選ぶようにしなくてはなりません。
　ということで、前回までに作ったプログラムにコードを追加していきます。まず、追加するのは1～40までの数字の中から選ばれた数字とその隣の名前をを書いたセルを削除して上に詰めるというコードです。
rd = WorksheetFunction.RandBetween(1, ninzu)で1～40までの数字からランダムに一つ選び、B12～B51の範囲の中からその数字が入っているセルを見つけ出して、その隣のセルに入っている苗字を表示させていたので、その2つのセルを削除して上に詰めます。その後、B列の数字を1から振りなおせばよいのでコードは以下のようになります。

Sub 当選者決め()
Dim ws As Worksheet
Dim lastRow As Long, rd As Long, ninzu As Long
Dim mydata As String

Set ws = ThisWorkbook.Worksheets("抽選")
    '名前一覧に掲載されている名前の個数（＝人数）を数える
    lastRow = ws.Cells(12, 3).End(xlDown).Row
    ninzu = lastRow - 11

    '1から人数までのランダム整数をrdに入れる
'    rd = FRANDBETWEEN(ninzu)
    rd = WorksheetFunction.RandBetween(1, ninzu)
    
Dim searchRange As Range, cell As Range
Dim name As String, Add As String
Set searchRange = ws.Range(Cells(12, 2), Cells(lastRow, 2))
    For Each cell In searchRange
        If cell.Value = rd Then
            name = cell.Offset(0, 1).Value
            Add = cell.Address
            Debug.Print Add
        End If
    Next cell

    '抽選結果を書き込む
    ws.Range("C9").Value = name
    ws.Range("L6").Value = name
        
    Dim targetRange As Range, lastrowB As Long, i As Long
    Set targetRange = ws.Range(Add, ws.Range(Add).Offset(0, 1))
    targetRange.Delete Shift:=xlUp
  
    lastrowB = ws.Cells(ws.Rows.count, "B").End(xlUp).Row
    For i = 12 To lastrowB
        ws.Cells(i, "B").Value = i - 11
    Next i
    
End Sub

2番ロッカーの人の名前をL列に入力

　2番目の人を39人の中から選べるようになりましたので、次は選んだ人の苗字をL列に入力したいですが、今のままだとL6セルにしか入りません。なのでここも行番号を変数を使って空のセルに入力するようにしていきます。
Cells(Rows.count, 12).End(xlUp).rowでL列の最終セルの行番号を取得して、その一つ下のセルに入力するようにして完成したのが以下のコードです。

Sub 当選者決め()
Dim ws As Worksheet
Dim lastRow As Long, rd As Long, ninzu As Long
Dim mydata As String

Set ws = ThisWorkbook.Worksheets("抽選")
    '名前一覧に掲載されている名前の個数（＝人数）を数える
    lastRow = ws.Cells(12, 3).End(xlDown).row
    ninzu = lastRow - 11

    '1から人数までのランダム整数をrdに入れる
'    rd = FRANDBETWEEN(ninzu)
    rd = WorksheetFunction.RandBetween(1, ninzu)
    
Dim searchRange As Range, cell As Range
Dim name As String, Add As String
Set searchRange = ws.Range(Cells(12, 2), Cells(lastRow, 2))
    For Each cell In searchRange
        If cell.Value = rd Then
            name = cell.Offset(0, 1).Value
            Add = cell.Address
            Debug.Print Add
        End If
    Next cell

    ws.Range("C9").Value = name
    
    Dim row As Long
    row = ws.Cells(Rows.count, 12).End(xlUp).row
    ws.Cells(row + 1, 12).Value = name
        
    Dim targetRange As Range, lastrowB As Long, i As Long
    Set targetRange = ws.Range(Add, ws.Range(Add).Offset(0, 1))
    targetRange.Delete Shift:=xlUp
  
    lastrowB = ws.Cells(ws.Rows.count, "B").End(xlUp).row
    For i = 12 To lastrowB
        ws.Cells(i, "B").Value = i - 11
    Next i
    
End Sub

このコードを40回実行すれば、40人すべての人がどのロッカーを使うかを決めることができますね。

　次回以降で細かい修正をしていきましょう。