この記事を読むのに必要な時間は約 9 分です。
Twitterで抽選を行っているのを見かけたので、Excel VBAで抽選マクロを作ってみました。
ソースコードを貼り付けて、枠とボタン１つ用意すれば動くようにしています。
VBAを勉強する方は、改造してみたら参考になるかもしれません。
ガチな人からはダメだしをくらいそうですがご容赦を・・・。
目次（リンク）
Excel VBAの抽選マクロを作ってみた
今回作ったマクロはこんな感じです。
- ボタンをクリックすると、下に貼り付けた応募者一覧からランダムで１名を抽出
- 貼り付けていなかったらエラー
- 間が抜けていてもエラー
一覧の名簿には、ウィキペディアから西武ライオンズの方々のお名前を記載させていただいています。
抽選マクロの作り方
マクロのExcelファイルをそのまま公開すれば楽なんですが、ファイルに個人情報が入っちゃったりします。
それに、マクロの中身が分からない状態でダウンロードするのも不安かと思いますので、ソースコードなど出来るだけコピペで作って実行できるように解説したいと思います。
当選者と抽選対象者の枠を用意
まずは枠を用意します。
図と同じ位置に貼り付けてください。
当選者のところ：B4セルから貼り付け
| No | お名前 | コメント | |
|---|---|---|---|
| ★当選者★ |
抽選対象者のところ：C9セルから貼り付け
| No | お名前（敬称略） | コメント |
|---|---|---|
抽選ボタンを作る
「開発」タブから、「挿入」、コマンドボタン（ActiveX コントロール）をクリックして、ボタンを入れます。
「開発」タブが表示されていないときは、こちらの記事の最初のほうを参考にしてみてください。
ボタンが入りました。
「CommandButton1」って何だよ？と思う方もいらっしゃるかも。
やっぱりボタン名は変更しておきたいですよね。
デザインモードの状態で、ボタンを右クリックしてプロパティを開きます。
プロパティにはいろいろと項目がありますが、変更するのはとりあえず次の２つで大丈夫です。
「（オブジェクト名）」：ソースコード内で使うボタン名です。
今回は一応変更していますが、ぶっちゃけボタン１つだけなら変えなくても困りませんｗ
Captionを変更した通りに、画面の表示も変更されました。
ソースコードを作成
今度はボタンをクリックしたときの動作について、ソースコードを書いていきます。
「SelectButton1」というボタンをクリックしたときの動作が、次のように書かれています。
|
1 2 3 |
Private Sub SelectButton1_Click() End Sub |
ボタンをクリックしたら何して欲しいのか、この中に書けば抽選出来るわけです。
が、ちょっといったん置いておきます。
「Microsoft Excel Objects」を右クリックして、「挿入」から「標準モジュール」を選択します。
「Module1」が出来ます。
「Module1」を右クリックして、中にソースコードを書きます。
もしも書き方が分からない場合は、ソースコードをコピペしちゃってください。
特定の範囲内で乱数を取得する
一応、ポイントになりそうなところだけ説明しておきます。
応募者の人数によって、生成する乱数の範囲を絞ります。
人数が１桁ならlNumLenは10、２桁なら100、3桁なら1000をセットするのがここです。
|
1 2 |
'"1"の後、リストの人数の桁数分、"0"を繰り返す lNumLen = CLng("1" & String(Len(sLastRowtmp), "0")) |
乱数を生成する関数は、「Rnd()」なのですが、出来るのは0以上1未満の値です。
先ほどのlNumLenを「Rnd()」に掛けることで、欲しい桁数の数字は整数部分。
Int関数で整数部だけ取り出します。
あとは、Do Loopで応募者の人数以下になるまでループします。
|
1 2 3 4 5 6 |
Do '1未満の乱数Rnd()にlNumLenを掛けて、整数部だけ取り出す lSelectNo = Int(Rnd() * lNumLen) 'リストの数以内の値になるまでループ Loop While lLastRow - 10 < lSelectNo |
Module1：
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 |
Option Explicit Public sMsgString As String '抽選のメイン関数 Public Sub selectPersonMain() Dim lSelectNo As Long Call checkPersonList If checkPersonList = True Then Call getSelectNo(lSelectNo) Call setSelectPerson(lSelectNo) sMsgString = "抽選結果が出ました！！" End If MsgBox sMsgString End Sub '引数 lSelectNo Long 参照渡し 当選した人の行数 'リストの数の中で、生成した乱数に一致する行数を取得 Private Sub getSelectNo(ByRef lSelectNo As Long) Dim lMax As Long Dim lMin As Long '一覧の最終行を乱数の最大値にセット lMax = Cells(Rows.Count, 4).End(xlUp).Row '乱数の最小値 lMin = 10 '乱数初期化 Randomize '最小値から最大値の範囲で乱数を生成 lSelectNo = Int((lMax - lMin + 1) * Rnd + lMin) End Sub '引数 lSelectNo Long 値渡し 当選した人の行数 '当選した人の情報を当選者欄にセット Private Sub setSelectPerson(ByVal lSelectNo As Long) 'Noをセット Cells(5, 3).Value = Cells(lSelectNo, 3).Value 'お名前をセット Cells(5, 4).Value = Cells(lSelectNo, 4).Value & " 様" 'コメントをセット Cells(5, 5).Value = Cells(lSelectNo, 5).Value End Sub '一覧未入力、途中抜けの場合のエラーチェック Private Function checkPersonList() As Boolean checkPersonList = True Dim lLastRowName As Long Dim lTopRowName As Long lLastRowName = Cells(Rows.Count, 4).End(xlUp).Row lTopRowName = Cells(9, 4).End(xlDown).Row '10行目以降に1件も入力されていない場合エラー If lLastRowName < 10 Then sMsgString = "抽選対象のリストが入力されていません" checkPersonList = False '10行目から最終行の間に、名前が書かれていない行があればエラー ElseIf lLastRowName <> lTopRowName Then sMsgString = "抽選対象のリストには、間を開けずに入力してください" & vbCrLf & lTopRowName + 1 & "行目が空欄です" checkPersonList = False End If End Function |
Module1の中に書いた「selectPersonMain」が本体です。
あとは、「SelectButton1_Click()」から「selectPersonMain」を呼び出すだけ。
|
1 2 3 |
Private Sub SelectButton1_Click() Call selectPersonMain End Sub |
「SelectButton1_Click()」の「_」より手前の部分は、プロパティの（オブジェクト名）と一致させてくださいね。
これでボタンをクリックしたら動くはずです。
テスト
正常なヤツ
ちょっと抽選ボタンを押して、動作を確認してみます。
ちゃんと動いたっぽいので、今度は何回もやってみます。
毎回同じ人が当選していたらダメですから。
そしたら、ちゃんと毎回違う人が当選者となりました。
これで抽選する動作は大丈夫です。
エラーになるヤツ
エラーチェックの動作も確認します。
途中の名前が空欄の場合、エラーメッセージを表示します。
複数行未入力でも、「〇〇行目が空欄です」の〇〇は一番上の行だけ。
楽してすみません・・・。
全部出していたら、何百行も未入力だと、エラーメッセージがスゴイことになっちゃいますからね。
未入力時のエラーチェックです。
一覧が未入力の場合でも、エラーだと判定してくれました。
実は、名前の列で未入力かどうか判定しています。
名前の列以外が入力済みでもエラーになります。
名前だけ入力していないとか、おそらく無いと思うのでたぶん大丈夫。
抽選対象者の一覧を貼り付けてボタンを押すだけのシンプルなマクロだし、複雑なチェックも必要ないでしょう。
まとめ：Excel VBAで抽選マクロ作成
Excel VBAで抽選のマクロを作ってみました。
応募者の一覧を貼り付けて抽選する場合には使えると思います。
VBAを勉強するネタとしてならもっと使えるかもしれません。
Twitterでよくやっている、「リプくれた方の中から抽選で１名にプレゼント」のような場合だと、一覧を作るだけで消耗しそうです(笑)
KUMAPさんがやっていた、応募日時をランダムで取得するやり方がシンプルですぐ出来ていいやり方だと思います。
リプくれたアカウント一覧って、API使って上手いこと一覧を作れるんですかね。
また時間があったらやってみます。
