エクセルVBAで抽選表を作成 人数でサイズを変更できる

extyusenranhyoeyecatch

エクセルVBA抽選ソフトの作り方を紹介していきます。
今回は参加者IDを抽選表に落とし込みます。大人数に対応可能です。
Rnd関数を使いランダムなID配置を行います。

こんにちは、じゅんぱ店長(@junpa33)です。

今回から、エクセルVBA抽選ソフトの作り方を紹介していきます。

初回となる今回は、抽選のためのベースとなる「抽選表」の作成です。

抽選参加人数に合わせてフレキシブルに表示させることが必要になります。

エクセル抽選表を利用する意味

tyusenranhyouNp004

エクセルを使って抽選をしようとしたときに、みなさんは、あまり抽選表は使っていないと思います。

このソフトで抽選表を使うことで、大きく3点の効果ありと考えました。

  • 抽選途中のプロセスを他の人(参加者)に見せることが出来る。
  • 複数回、乱数を発生させることで無作為性と公平性を担保することが出来る。
  • 一つの抽選会で、簡単に、内容の違う複数の賞を個別に設定できる。

 抽選途中のプロセスを他の人(参加者)に見せる

多くの場合、そうだと思いますが、エクセルのRnd関数で抽選プログラムを作っていくときには、

「一つの列で1行目から順に乱数を発生させて、参加人数分の乱数値を取得する。」ということになると思います。

その方法では直ぐに、モニタ画面から乱数の発生行が見えなくなって、画面スクロールしないと進行結果がどうかさえも分からなくなります。

あるいは、当選結果だけを一覧表を使って画面表示するパターン(プロセスは抜きです)という方法もあるかと思います。

抽選作業をしているとは言っても、横から見ている応募者・参加者の人がいれば、何がどうなったのか、結論だけあっという間で、

「楽しむ隙間」もないでしょう。その人は結果にキョトンとしているだけではないでしょうか。

参加者(応募者)にとっての抽選の楽しみは「当選までのプロセス」です。

そこで、この抽選プロセスを見える化させるための、一つの解決策が「乱数表(抽選表)の利用」ということになりました。

全く完全密室の事務作業で進める抽選ではなく、

開催側でも「参加者には少しでも楽しんでほしいと企画した」抽選であれば、

そして、さらにお金と時間をかけて行う抽選であれば、パソコン抽選であっても

抽選にイベント的なおもしろ味は必要だと思います。

お金を払って、市販の有料アプリを使えばよいのでしょうが、

そこはそこ、予算面と手作り感も欲しい時が多くあると思います。

複数回、乱数を発生させることで無作為性と公平性を担保

イメージとして、一般的にコンピュータによる抽選は、手で行うものより公平という感覚はあります。

でも、一瞬で当たりはずれが決まれば、やっぱり「え?ほんと」という気持ちになってしまいます。

この「一瞬」で判明するのが、変な懐疑心を参加者に生み出す要因にもなります。

いい意味で、抽選には、参加者に期待させる「もったいぶる時間」が必要だということです。

この「もったいぶる時間」を作る方法として、その時間に複数回乱数を発生させることで抽選を行い、

同時に無作為性と公平性を担保していくという方法をとっています。

複数の賞を個別に設定

一つの抽選イベントで、内容の違う複数の賞を設定できて、同時進行で抽選作業を実行することが出来ます。

単に参加人数分の乱数を一度に発生させ当選を決める方法では、すべての当選を一度に決めてしまうことが必要になります。

乱数を発生させる度に、前回発生の結果が上書きされてしまいます。複数回抽選するには、前回結果を保存していく作業が必要です。

エクセル関数式を使っている場合は特に注意が必要です。

エクセルVBAと乱数表を利用することによって、データの上書きを心配することなく、次の抽選を実行することが出来るようになります。

ビジュアル的にも、別セルに結果の書き出しと、乱数表(抽選表)上にそれまでの抽選結果を表示保存することが出来ます。

抽選表を参加予定人数に合わせて作る

tyusenranhyouNp005

今回、乱数表を作成するVBAコードは「Module1」に記述します。

「Module1」に記述する全コードは、このような内容になります。

その内、抽選表の作成に関係するコードは①から➄になります。

  • プロジェクト内とモジュール内で利用する変数の宣言
  • 乱数表作成するシートの初期化(クリア)
  • シート全体をデフォルト(リセット)する
  • 参加者数に応じた方眼紙の設定(乱数をはめ込むベース)
  • 参加者IDを乱数を使って方眼紙に配置する
  • ユーザーフォームに抽選名称を復旧させるコード
  • ユーザーフォームに抽選項目を復旧させるコード

プロジェクト内とモジュール内で利用する変数の宣言

代入された変数値をプロシージャー間で使い回す用の変数を宣言しています。

vbasengeneyecatch 宣言方法で変数の適用範囲を変える エクセルVBA
VBA
Option Explicit

Public Ar As Long
Public TYsheet, TOsheet, BUsheet As Worksheet
Public TItle, EVD As String
Public Par As Long
Dim Ama As Long
変数
  • Ar・・・・ 方眼紙の行数
  • TYsheet、TOsheet、BUsheet・ 「抽選会場」「当選者」「抽選項目BU」の各シート
  • Title、EVD・・・・ 「抽選名称」「抽選日時」
  • Par・・・・ 「抽選参加人数」
  • Ama・・・・ 「参加人数の計算加工上の余り」

抽選表作成するシートの初期化(クリア)

乱数表(抽選表)作成前に作成する場所「抽選会場」シートをクリアしておきます。

vbacleareyecatch シートクリアーを目的のメソッド別にVBA最速理解
VBA
Sub クリアG()
        Set TYsheet = Worksheets("抽選会場")
            With TYsheet
                .Cells.Clear
                .Cells.UseStandardHeight = True
                .Cells.UseStandardWidth = True
            End With
        Range("A1").Select
End Sub

シート全体をデフォルト(リセット)する

何かの用件で、ソフトをはじめて使う時の状態に戻す場合のVBAコードです。

全てのシートを初期化します。

fornextirekoeyecatch エクセルVBA!For~Nextのループと入れ子構造をVBA最速理解 vbadoloopeyecatch VBA 回数不定のループ処理はDo LoopとFor Each
VBA
Sub クリアS()
    Dim i As Long
        For i = 1 To Worksheets.Count
                With Worksheets(i)
                    .Cells.Clear
                    .Cells.UseStandardHeight = True
                    .Cells.UseStandardWidth = True
                End With
            Range("A1").Select
        Next i
        Worksheets(1).Range("A1").Select
End Sub

参加者数に応じた方眼紙の設定(乱数をはめ込むベース)

変数
  • SQRoot・・・・ 参加人数に応じた平方根
  • Culc・・・・ 参加人数と近似平方値との差数
  • Syo・・・・ Culcから計算した行の追加数
  • n・・・・ 参加人数に合わせたセルサイズを指定する

コード設計のポイント

例えば参加人数46人の場合は、

47 = 6 ^ 2 + 10 になります。それぞれの変数には

Par = 46

SQRoot = Fix(Sqr(Par)) なので
SQRoot = 6

Culc = Par – SQRoot ^ 2 なので
Culc = 10

Syo = Culc \ SQRoot なので
Syo = 1

Ama = Culc Mod SQRoot なので
Ama = 4

が代入されます。

参加人数によって方眼紙サイズを変更します。

変数nをセルサイズを変更する係数として、参加人数に応じて変化させます。

方眼紙部分のセルについてベースの色を設定します。8行6列の方眼を作成します。

tyusenranhyouNp001
vbaintfixeyecatch Int・Fix・Abs・Sign関数を使って数値の整数部分を完全分離 vbaselectcaseeyecatch Select Case 条件分岐の使い方。ステートメントの基本はコレ。 vbawithstateeyecatch With~End Withの使い方。VBAコードを簡潔に記述する vbamsgboxeyecatch メッセージボックス MsgBox実際の使い方を最速に理解 vbafontsyseyecatcha Fontプロパティで文字装飾操作をする vbacellspaintbackeyecatch 「塗りつぶし」背景色をVBAで記述する
VBA
Sub 応募者方眼紙()
    Dim SQRoot As Double  '参加人数の平方根
    Dim Culc As Long      '参加人数-平方近似数の余り
    Dim Syo As Long       '余りの行数
    Dim n As Double       '行列の規模による文字サイズ等の変化数
        Set TYsheet = Worksheets("抽選会場")
        TYsheet.Select
'参加人数の入力チェック
        If 選定ナビ.参加人数.Value = "" Then
            MsgBox "参加人数が入力されていません。" & vbCrLf & _
                "半角数字を入力してください。", vbOKOnly, "メッセージ"
            Exit Sub
        End If
'方眼サイズ計算値を変数に代入
        Par = 選定ナビ.参加人数.Value
        SQRoot = Fix(Sqr(Par))
        Culc = Par - SQRoot ^ 2
        Syo = Culc \ SQRoot
        Ama = Culc Mod SQRoot
'表題表記
        With Range("A1")
            .Value = "【当選者選定プログラム】"
            .Font.Size = 21
            .Font.Bold = True
            .Font.ColorIndex = 32
        End With
'抽選名等情報表示
    TItle = 選定ナビ.抽選名称.Value
    EVD = 選定ナビ.開催日付.Value
        With Range("A3")
            .Value = TItle & "-" & EVD
            .Font.Size = 18
            .Font.Bold = True
            .Font.ColorIndex = 1
        End With
        With Range("J3")
            .Value = "参加人数は、" & Par & " 人です。"
            .Font.Bold = True
            .Font.Size = 15
            .Font.ColorIndex = 18
        End With
'方眼用紙サイズ計算・表示
  '行数
        Select Case Syo
        Case Is > 1
            Ar = SQRoot + Syo
        Case Is = 1
            Ar = SQRoot + 1
        Case Is > 0
            Ar = SQRoot + 1
        Case Is = 0
            Ar = SQRoot
        Case Else
            Ar = SQRoot
        End Select
        If Ama > 0 Then Ar = Ar + 1
        Range(Cells(4, 4), Cells(4 + Ar - 1, 4 + SQRoot - 1)).Select
        Selection.Font.Size = Application.StandardFontSize
  '表示フォントサイズ設定
        Select Case Par
            Case Is < 625
                n = 1
                Selection.Font.Size = 9
            Case Is < 3001
                n = 1
                Selection.Font.Size = 8
            Case Is < 6001
                n = 0.8
                Selection.Font.Size = 7
            Case Is < 10000
                n = 0.8
                Selection.Font.Size = 7
            Case Is < 100000
                n = 0.8
                Selection.Font.Size = 5
            Case Else
                n = 0.6
                Selection.Font.Size = 4
        End Select
  'セルサイズ設定
        With Selection
            .RowHeight = 22.5 * n
            .ColumnWidth = 3.13 * n
            .Interior.ColorIndex = 34
        End With
        Cells.RowHeight = 22.5 * n
        Range("1:3").RowHeight = 22.5
  '用紙行数表示
        With Range("B2")
            .Value = "全" & Ar & "行"
            .Font.Bold = True
            .Font.Size = 15
        End With
        Range("A2").Select
End Sub

参加者IDを乱数を使って方眼紙に配置する

変数
  • i、j・・・・ カウンター変数
  • Tc・・・・ 乱数表上のセル位置を指定する(列)
  • Tr・・・・ 乱数表上のセル位置を指定する(行)

コード設計のポイント

抽選参加者に付与されているID番号を、それぞれに取得した乱数を使って方眼紙(乱数表)に配置していきます。

それぞれ取得した乱数の並び替えは、Sortメソッドで行うのが高速です。

方眼紙への配置は、ソート順に左上のセルから行方向下へ順に配置していきます。

参加者IDの方眼へのランダム配置全VBA

vbarndeyecatch Rnd関数で乱数を取得。使えない戻り値を加工して利用度を上げる vbasorteyecatch データの並び替え VBA新旧のSortを実データで実証
VBA
Sub 応募者配置乱数()
    Dim i, j As Long
    Dim Tc As Long
    Dim Tr As Long
        Set TYsheet = Worksheets("抽選会場")
        TYsheet.Select
        Randomize
'参加者ID番号に乱数を付与する
        For i = 1 To Par
            Cells(i + 3, 1) = i
            Cells(i + 3, 2) = Rnd
        Next i
'乱数を基準に昇順並べ替えを行なう(方眼紙の番地を決める)
        Range("A4:B" & 3 + Par).Sort key1:=Range("B4"), order1:=xlAscending
'方眼紙のマスに左上~左下、左から右へ参加者IDを記入する
        For i = 1 To Par
            Cells(i + 3, 3) = i
            Tc = i \ Ar
            Tr = i Mod Ar
            If Tr > 0 Then
                Tc = Tc + 1
            ElseIf Tr = 0 Then
                Tr = Ar
            End If
            Cells(Tr + 3, Tc + 3) = Cells(i + 3, 1)
        Next i
'方眼紙未利用番地のセル色削除
        If Ama <> 0 Then
            Range(Cells(Tr + 3 + 1, Tc + 3), Cells(Ar + 3, Tc + 3)).Select
            Selection.Interior.ColorIndex = 0
            Range("A1").Select
        Else
        End If
'4行目以降のA,B,C列の表示内容を変更する
        Range(Cells(12, 1), Cells(Par + 11, 3)).Clear
        Range("A4") = "賞名"
        Range("B4") = "当選者数"
        Range("C4") = "未決数"
'パブリック変数PrN()、PrQ()を表示する
        For j = 1 To 6
            Range("A" & 4 + j) = PrN(j)
            Range("C" & 4 + j) = val(StrConv(PrQ(j), vbNarrow))
        Next j
        Range("A11") = "賞名"
        Range("B11") = "当選順位"
        Range("C11") = "当選者ID"
        With Range("A4:C11")
            .Font.Bold = True
            .Font.Size = 13
            .ColumnWidth = 11
        End With
        With Range("A4:C4")
            .Interior.ColorIndex = 28
        End With
        With Range("A11:C11")
            .Interior.ColorIndex = 28
        End With
        Range("A2").Select
        For i = 5 To 10
            Cells(i, 2) = 0
        Next i
        Columns("A").ColumnWidth = 20
        TYsheet.Select
End Sub

参加者IDを方眼紙にランダム配置(前半コード)

作業手順

  • 参加者ID分の乱数(0から1)を発生させます。
  • 発生させた乱数を昇順ソートすることで、参加者IDを ” ランダムにシャッフル ” することが出来ます。
  • 昇順ソート順に方眼マスに左上から下へ順番に入力していきます。
tyusenranhyouNp002
Sub 応募者配置乱数()
    Dim i, j As Long
    Dim Tc As Long
    Dim Tr As Long
        Set TYsheet = Worksheets("抽選会場")
        TYsheet.Select
        Randomize
'参加者ID番号に乱数を付与する
        For i = 1 To Par
            Cells(i + 3, 1) = i
            Cells(i + 3, 2) = Rnd
        Next i
'乱数を基準に昇順並べ替えを行なう(方眼紙の番地を決める)
        Range("A4:B" & 3 + Par).Sort key1:=Range("B4"), order1:=xlAscending
'方眼紙のマスに左上~左下、左から右へ参加者IDを記入する
        For i = 1 To Par
            Cells(i + 3, 3) = i
            Tc = i \ Ar
            Tr = i Mod Ar
            If Tr > 0 Then
                Tc = Tc + 1
            ElseIf Tr = 0 Then
                Tr = Ar
            End If
            Cells(Tr + 3, Tc + 3) = Cells(i + 3, 1)
        Next i
'方眼紙未利用番地のセル色削除
        If Ama <> 0 Then
            Range(Cells(Tr + 3 + 1, Tc + 3), Cells(Ar + 3, Tc + 3)).Select
            Selection.Interior.ColorIndex = 0
            Range("A1").Select
        Else
        End If

参加者IDを方眼紙にランダム配置(後半コード)

作業手順

  • A列、B列、C列で参加者IDごとに乱数を発生させるなど作業を行いましたが、作業後はそのデータは不要になります。
  • その後に賞名と当選者などを表示するスペースに変更します。
tyusenranhyouNp003
'4行目以降のA,B,C列の表示内容を変更する
        Range(Cells(12, 1), Cells(Par + 11, 3)).Clear
        Range("A4") = "賞名"
        Range("B4") = "当選者数"
        Range("C4") = "未決数"
'パブリック変数PrN()、PrQ()を表示する
        For j = 1 To 6
            Range("A" & 4 + j) = PrN(j)
            Range("C" & 4 + j) = val(StrConv(PrQ(j), vbNarrow))
        Next j
        Range("A11") = "賞名"
        Range("B11") = "当選順位"
        Range("C11") = "当選者ID"
        With Range("A4:C11")
            .Font.Bold = True
            .Font.Size = 13
            .ColumnWidth = 11
        End With
        With Range("A4:C4")
            .Interior.ColorIndex = 28
        End With
        With Range("A11:C11")
            .Interior.ColorIndex = 28
        End With
        Range("A2").Select
        For i = 5 To 10
            Cells(i, 2) = 0
        Next i
        Columns("A").ColumnWidth = 20
        TYsheet.Select

抽選表をエクセルVBAで作る まとめ

tyusenranhyouNp006

このエクセルVBA抽選ソフトの抽選のベースとなる抽選表を作成しました。

一つの抽選イベント毎に、この抽選表を作成することになります。

次には、この抽選表を使って、

抽選イベントの中のいくつかの〇〇賞の抽選を、抽選する賞の回数分この抽選表の上で行っていくことになります。

エクセルVBAを独習するのに参考書は欠かせません。 参考書選びは自分に合った「相棒」にできるものを選んでいきたいです。

vbastudyeyecatch2 エクセルVBAの独習でおすすめ参考書を7冊選ぶ。良書との出会いは大切です

今回の記事はここまでです。   最後までご覧いただき有難うございました。

エクセルVBA最速理解で必要な知識を集めよう!

エクセルVBA業務ツールで日常の業務改善を行いましょう。

<記事内容についての告知>VBAコードの記述記事においては、その記述には細心の注意をしたつもりですが、掲載のVBAコードは動作を保証するものではりません。 あくまでVBAの情報の一例として掲載しています。 掲載のVBAコードのご使用は、自己責任でご判断ください。 万一データ破損等の損害が発生しても当方では責任は負いません。