【VBA】エクセルマクロで抽選！面倒な抽選作業をデジタル化しよう！

〇社長がスポーツ観戦チケットをくれた！

〇取引先から贈答品をいただいた！

 

こんなとき、欲しい人が集まって、ジャンケンやあみだくじをやっている職場は多いのではないでしょうか？

 

しかし、このご時世です。

 

なかなか人が集まるのも大変ですよね。

 

というわけで、この記事では、エクセルを使った抽選マクロの作り方をご紹介します。

 

この記事に書かれていることをコピーするだけで簡単に作成できます。

 

ぜひ職場の共有フォルダにひとつ作っておきましょう！

 

エクセル抽選マクロの作り方

今回は以下の仕様で作成しています。

〇エントリーする人数は何人でもOK

〇当選者数も自由に設定可能

 

それでは作成手順に移っていきます。

 

エクセルシートを整える

まずは以下の画像を参考にエクセルシートを整えます。

VBAコードを記述

次にVBAコートを記述していきます。

コードの記述方法がわからない方は以下の記事を参考にしてください。

www.higashisalary.com

 

準備ができたら以下のコードをコピーして記述してください。

Sub chuusen()
    Application.ScreenUpdating = False
    Dim num_tousen As Integer
    Dim i As Integer, j As Integer
    Dim k As Integer, m As Integer
    Dim base_num As Variant
    '乱数の割り当て
    i = 1
    Do Until Cells(3 + i, 1) = ""
        Cells(3 + i, 2) = Int(Rnd() * 100000)
        i = i + 1
    Loop
    '当選者の選択
    For num_tousen = 1 To Cells(2, 1)
        base_num = 0
        j = 1
        Do Until Cells(3 + j, 1) = ""
            If IsNumeric(Cells(3 + j, 2)) = True Then
                If Cells(3 + j, 2) > base_num Then
                    base_num = Cells(3 + j, 2)
                Else
                End If
                Else
            End If
            j = j + 1
        Loop
        k = 1
        Do Until Cells(3 + k, 1) = ""
            If Cells(3 + k, 2) = base_num Then
                Cells(3 + k, 2) = "当選"
            Else
            End If
            k = k + 1
        Loop
    Next
    '乱数削除
    m = 1
    Do Until Cells(3 + m, 1) = ""
        If IsNumeric(Cells(3 + m, 2)) = True Then
            Cells(3 + m, 2) = ""
        End If
        m = m + 1
    Loop
    Application.ScreenUpdating = True
End Sub

抽選ボタンの作成

コードが記述できたら次は抽選ボタンを作成していきます。

 

ボタンの作成方法については以下の記事を参照ください。

www.higashisalary.com

 

私の場合はこんな感じにボタンを配置しました。

実行結果の確認

これで完成です。

さっそくマクロを実行してみましょう！

 

きちんとA2セルに入力された当選者数の数だけ、当選者が出ていますね。

 

何度やってもやってもランダムに当選者が抽選されるはずです。

 

マクロ有効ブックとして保存

動作確認まで終わったら、しっかりと保存しておきましょう。

 

手順は以下の通りです。

①ファイルタブを選択

②名前をつけて保存

③保存場所を選択

④ファイル名を入力

⑤マクロ有効ブックを選択（下の画像を参考）

⑥保存をクリック

これで次回からはいきなり抽選が行えますね。

 

当選確率の検証

作成方法はわかっていただけたと思いますが、

「本当に公平に抽選されるの？」

こんなことを考えている人も多いと思います。

 

というわけで、このマクロの公平性を確認する手法についてもご紹介しておきます。

 

やることは非常にシンプル。

〇当選者を２人に設定

〇さきほど作った抽選マクロを１００００回実行する

⇒各自の当選回数をカウントしておく

〇各自の当選回数を抽選回数（１００００×２）で割る

こんな手順で当選確率が公平であるかを確認していきます。

 

検証用VBAコード

とはいえ、１００００回も手動でやってられませんので、これもマクロで自動化しておこないます。

 

以下が当選回数を数えながら、１００００回抽選マクロを実行するコードです。

Sub kakuritu_test()
    Dim i As Integer, j As Integer
    For i = 1 To 10000
        Call chuusen
        j = 1
        Do Until Cells(3 + j, 1) = ""
            If Cells(3 + j, 2) = "当選" Then
                Cells(3 + j, 3) = Cells(3 + j, 3) + 1
            End If
            j = j + 1
        Loop
    Next
End Sub

※VBA実行中に他のVBAコードを動かすには

Call  作ったマクロの名前

で実行できますので、覚えておくと良いでしょう。

 

当選確率検証コードが書けた方は実際に実行してみましょう！

 

※数分かかりますので実行する際はご注意ください。

 

当選確率の計算結果

以下がマクロで１００００回実行したときの当選回数の集計結果と、それを抽選回数で割った、各参加者の当選確率の結果です。

 

今回は１１人の参加者で行いましたので、当選確率は

１００÷１１≒９．０９％　です。

多少のばらつきはあるものの、ほぼ期待値通りの結果となっており、公平に抽選できていると言っていいのではないでしょうか。

※厳密にいうと、このマクロは上に書いてある人の方が極々わずかではありますが、当選確率が高くなっています。

 

その理由がわかれば、あなたはプログラミングの才能ありです。

 

おわりに

というわけで、今回は抽選マクロの作り方をご紹介しました。

このご時世でなくても、景品の抽選なんて、わざわざ人が集まってやることでもないので、ぜひこの記事を参考にデジタル化を行っておきましょう。

 

このように、このブログでは、エクセル（VBA)を中心に、様々な効率化スキルを紹介しています。

■日々の業務効率を上げたい。

■早く帰って子供と遊びたい。

こんな人はぜひ他の記事も読んでみてください。

また、VBAを使ってこんなことがしたいんだけど、やり方がわからない、という悩みを抱えているかたは、お気軽にコメント欄から質問してください。

私にわかる範囲であればご協力いたします。（もちろん無料です。）

 

最後に・・・

このブログを応援してあげても良いよ、という方は以下のボタンをポチっていただけると嬉しいです。

にほんブログ村

Twitterもやっていますので、興味があれば覗いてみてください。

Follow @HigashiSalary

それではまた！！