抽選を実行するVBAコードを組み立てる-抽選ソフト作成2

tyusenjikkoueyecatch

エクセルVBA抽選ソフトの作成方法説明の2回目です。
今回はエクセルVBA抽選の実行コードを組み立て方を解説します。
抽選方法にバリエーションを設定していますので、抽選のイベント性がより高くなります。

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

今回のエクセルVBA抽選ソフトの作り方の紹介は、「抽選実行コードの仕組み」づくりです。

一つの抽選イベントで、複数(6つ)の賞の抽選が出来るようにしたいと思います。

前の記事を読み直すのはこちら↓からです。

乱数表(抽選表)を人数に合わせて作る-エクセルVBA抽選ソフト作成1

「エクセルVBA抽選ソフト無料版」の記事一覧を開く

抽選を実行するVBAコードの組み立てる内容

抽選の実行プログラムの中で、

実行時にさせたいことは大きく次の6点になります。

そしてこの記事では、②から⑥の項目に関して説明していきます。

これらはModule2へのコード記述になります。

  1.  ユーザーフォームで、抽選作業のすべてをコントロールする
  2.  一つの抽選イベントで6つの賞を設定でき、個別に抽選作業をすることが出来る
  3. 1つの賞の抽選に対して連続(一度にすべて)、単発(一回のみの抽選)の2種類の抽選方法を選択できる
  4. 抽選表に「抽選中」「当選」が視認できるようにする
  5.  先に当選していた場合は、次の当選は無効にする
  6. 設定した賞の進行状態を上部に表示する

抽選を実行するエクセルVBAコード

今回のエクセルVBAコードは「Module2」に記述します。

「Module2」に記述する全コードは次のようになります。

  1.  プロジェクト内とモジュール内の変数宣言
  2.  抽選の実行プロシージャー
  3.  連続抽選のためのプロシージャー
  4.  単発抽選のためのプロシージャー
  5. 重複当選チェックのプロシージャー
  6. 当選番号リストアップのプロシージャー
  7. 当選者集計のプロシージャー

①プロジェクト内とモジュール内の使用変数の宣言

プロジェクト内とこのModele2内で使う変数を宣言します。

コード

Option Explicit
'Windows API Sleep関数の使用宣言
Private Declare Sub Sleep Lib "kernel32" (ByVal ms As Long)
'最終行の行数
Public Arow, SYOrow, SETrow As Long
'賞名
Public VName As String
'当選本数
Public Hon, Zan, Cot As Long
'抽選表のセル行列位置
Dim Vc, Vr As Long
'重複当選指標、セル色コード
Dim Jfk, Col As Long
'Sleep関数の時間指定
Dim time As Long
'重複チェック指標
Dim MR As Long

宣言変数

  • Arow・・・・ B列の最終行、 SYOrow・・・・ A列の最終行、 SETrow・・・・ A列とB列の最終行
  • VName・・・・ 6つの賞名
  • Hon・・・・ 各賞の当選本数、 Zan・・・・ 各賞の当選残数、 Cot・・・・ 当選順位
  • Vc・・・・ 抽選表のセル位置(列)、 Vr・・・・ 抽選表のセル位置(行)
  • Jfk・・・・ 重複当選が発生した回数をカウント、 Col・・・・ 抽選表の元のセル色を保存
  • time・・・・ Sleep関数の休止時間を規定する
  • MR・・・・ 重複当選になるかどうかの判断指標
MEMO

変数宣言の方法についてはこちらを参考にしてください。

変数の宣言方法で適用範囲をコントロールするVBA記述

②抽選の実行プロシージャー

抽選を実行する本体のプロシージャーになります。

そのほか部品化された他のプロシージャーがここから呼び出されていきます。

宣言変数

  • SelT・・・・ Falseなら単発抽選、Trueなら連続抽選
  • YN・・・・ 「0か1」抽選方法の識別に使う Module3で規定
  • PrN()・・・・ 賞名 Module3で規定
  • PrQn()・・・・ 当選本数 Module3で規定
  • ST・・・・ ユーザーフォームの6つの賞の抽選ボタンの識別

コード設計のポイント

抽選イベントで6つの賞を抽選できるようにし、さらにそれぞれに単発抽選と連続抽選を設定しています。

このプロシージャーは、ユーザーフォームの合計12個のコマンドボタンから12種類の抽選実行命令が入ってきます。

実行条件の差異分岐を、簡潔にコード記述するため、If条件文ではなく、Select Case文を使っています。

各抽選実行ボタンで共通のコード処理となる部分は、(自分としての)可読性を考慮して、部品プロシージャー化しています。

(どこまで部品化するかは個人的所見があると思います。)

各賞の抽選状況の集計を上部に表示します。

当選者に対して、賞名と当選順位、当選者番号を当選順に表示していきます。

tyusentyujikko001a

コード

Sub 抽選会()
'SelTで単発抽選かどうかを判断します
    Dim SelT As Boolean
    
        Set TYsheet = Worksheets("抽選会場")
        TYsheet.Select
        If Range("A1") = "" Then Exit Sub
    
        Arow = Cells(Rows.Count, 2).End(xlUp).Row
        Range("C1").Clear
        Ar = Val(Mid(Range("B2"), 2))
    'Parは参加人数
        Par = Val(Mid(Range("J3"), 7))
        VName = ""
        Jfk = 0
    'YNは抽選方法の識別標識ですModule3で規定
        If YN = 0 Then
            SelT = False
        ElseIf YN = 1 Then
            SelT = True
        End If
        
    'STは設定ナビの12個の抽選ボタンに値が割り振られています
    'PrN()は賞名、PrQn()は当選本数 Module3で規定しています
        Select Case ST
            Case Is = 1
                VName = PrN(1)
                Hon = PrQn(1) - Range("B5")
            Case Is = 2
                VName = PrN(2)
                Hon = PrQn(2) - Range("B6")
            Case Is = 3
                VName = PrN(3)
                Hon = PrQn(3) - Range("B7")
            Case Is = 4
                VName = PrN(4)
                Hon = PrQn(4) - Range("B8")
            Case Is = 5
                VName = PrN(5)
                Hon = PrQn(5) - Range("B9")
            Case Is = 6
                VName = PrN(6)
                Hon = PrQn(6) - Range("B10")
        End Select
    
        SYOrow = Cells(Rows.Count, 1).End(xlUp).Row
    '抽選中の賞名を当選一覧で表示するセル位置を決める
        If VName <> Cells(SYOrow, 1) Then
        
            If Arow = SYOrow Then
                SETrow = 0
            ElseIf Arow > SYOrow Then
                SETrow = Arow - SYOrow
            ElseIf Arow < SYOrow Then
                SETrow = -1
            End If
            
            With Range("A" & SYOrow + 1 + SETrow)
                .Value = VName
                .Font.Size = 13
                .Font.Bold = True
                .Font.ColorIndex = 3
            End With
        
        End If
        
        If SelT = True Then
            Call Module2.連続抽選
        ElseIf SelT = False Then
            Call Module2.単発抽選
        End If
    '抽選完了表示
        With Range("A2")
            .Value = "抽選完了"
            .Font.Bold = True
            .Font.Size = 15
            .Font.ColorIndex = 2
            .Interior.ColorIndex = 53
        End With
    '重複当選表示
        With Range("C2")
        .Value = "重複当選 " & Jfk & " 回発生しました。"
            .Font.Bold = True
            .Font.Size = 13
        End With
    '当選未決数表示
        Select Case VName
            Case Is = PrN(1)
                Range("C5") = PrQn(1) - Range("B5")
            Case Is = PrN(2)
                Range("C6") = PrQn(2) - Range("B6")
            Case Is = PrN(3)
                Range("C7") = PrQn(3) - Range("B7")
            Case Is = PrN(4)
                Range("C8") = PrQn(4) - Range("B8")
            Case Is = PrN(5)
                Range("C9") = PrQn(5) - Range("B9")
            Case Is = PrN(6)
                Range("C10") = PrQn(6) - Range("B10")
        End Select

End Sub
MEMO

select Case ~ End Select ステートメントについてはこの記事を参考にしてください。

Select Case 条件分岐の使い方。ステートメントの基本はコレ。

With~End Withの使い方については、この記事を参考にしてください。

With~End Withの使い方。VBAコードを簡潔に記述する

Val関数についてはこちらを参考にしてください。

Val関数の使い方はデータ型不一致の解決策。値を文字列型から数値型へ

Mid関数についてはこちらを参考にしてください。

Mid関数・Right関数・Left関数は文字列操作の基本。使用例で解説します

データ入力済セルの最終行番号取得についてはこちらを参考にしてください。

データ入力済セルの最終行番号を取得するVBAコード

Fontプロパティの使い方についてはこちらを参考にしてください。

セルの文字設定でFontオブジェクトって何?最初に知っておくポイント全部

Callステートメントの使い方についてはこちらを参考にしてください。

Callステートメントはプロシージャーの部品化に必須項目 エクセルVBA最速理解

③連続抽選のためのプロシージャー

ユーザーフォームで連続抽選ボタンを押していた場合に起動します。

宣言変数

  • j・・・・ カウンター変数
  • Vicb・・・・ 排出乱数の整数部分
  • Vcb・・・・ Vicbから計算したセル位置(列)
  • Vrb・・・・ Vicbから計算したセル位置(行)
  • OPr・・・・ 連続抽選をするスピード Module3で規定

コード設計のポイント

乱数から抽選表のセル位置を決定する計算

輩出した乱数の整数部分が 97 の場合

Ar = 12 ,    Vicb = 97

Vcb = Vicb \ Ar なので

Vcb = 8

Vrb = Vicb Mod Ar なので

Vrb = 1 

If Vrb > 0 Then
 Vcb = Vcb + 1 なので

Vcb = 9 , Vrb = 1 となり

セル位置は、Cells(4,12)になります。(会長賞の当選セル)

コード

Sub 連続抽選()

    Dim j As Long                 'カウンター変数
    Dim Vicb, Vcb, Vrb As Long    '乱数とその加工値
    
    '乱数発生のパターン化防止
        Randomize
        Range("A2,C2,F1").Clear
        
    'OPrは連続抽選スピード Module3で規定
        Select Case OPr
            Case Is = 0
                time = 250
            Case Is = 1
                time = 300
            Case Is = 2
                time = 200
            Case Is = 3
                time = 100
        End Select
                  
    '抽選の本数分ループする
        For j = 1 To Hon
    
            Vicb = Int(Rnd * Par + 1)
            Vcb = Vicb \ Ar
            Vrb = Vicb Mod Ar
     
            If Vrb > 0 Then
                Vcb = Vcb + 1
            ElseIf Vrb = 0 Then
                Vrb = Ar
            End If
            
            Col = Cells(Vrb + 3, Vcb + 3).Interior.Color
            
            With Cells(Vrb + 3, Vcb + 3)
                .Interior.ColorIndex = 6
            Sleep time
                .Interior.Color = Col
            End With
    
            Vc = Vcb
            Vr = Vrb
           
            Call Module2.重複当選チェック
        '重複当選していなければ、このコードを実行
            If MR = 0 Then
            
                With Range("F1")
                    .Value = "只今の番号は、" & Cells(Vr + 3, Vc + 3) & " が当選です。"
                    .Font.Bold = True
                    .Font.Size = 13
                End With
            
            End If
                
        Next j
            
        Zan = Hon - Jfk
        
        Call Module2.当選者集計
        
End Sub

MEMO

Rnd関数の使い方についてはこちらを参考にしてください。

Rnd関数で乱数を取得。使えない戻り値を加工して利用度を上げるVBAコード

Int関数の使い方についてはこちらを参考にしてください。

数値の整数部分を完全分離 Int・Fix・Abs・Sign関数で出来る使い方

Select Case ~ End Select ステートメントについてはこの記事を参考にしてください。

Select Case 条件分岐の使い方。ステートメントの基本はコレ。

With~End Withの使い方については、この記事を参考にしてください。

With~End Withの使い方。VBAコードを簡潔に記述する

エクセルVBAのコード処理を指定時間止めるSleep関数

④単発抽選のためのプロシージャー

ユーザーフォームで単発抽選ボタンを押していた場合に起動します。

宣言変数

  • i・・・・ カウンター変数
  • Vica・・・・ 排出乱数の整数部分
  • Vca・・・・ Vicaから計算したセル位置(列)
  • Vra・・・・ Vicaから計算したセル位置(行)
  • VCount・・・・ 抽選の点滅回数

コード設計のポイント

乱数から抽選表のセル位置を計算するのは、連続抽選の場合と同じです。

抽選スピードを変化させます。

点滅数が増えるほど点滅スピードが遅くなる設計にします。

コード

Sub 単発抽選()

    Dim i As Long                 'カウンター変数
    Dim Vica, Vca, Vra As Long    '乱数とその加工値
    Dim VCount As Long        '抽選の点滅回数
    
    '乱数発生のパターン化防止
        Randomize
        
    'OPkは抽選の点滅回数 Module3で規定
        Select Case OPk
            Case Is = 0
                VCount = 15
            Case Is = 1
                VCount = 5
            Case Is = 2
                VCount = 10
            Case Is = 3
                VCount = 20
        End Select
                    
        Range("A2,C2,F1").Clear
        
    '抽選の点滅回数分ループする
            For i = 1 To VCount
        '抽選スピードを選択する
                Select Case OP
                    Case Is = 0
                        time = 500 * 0.2 * i
                    Case Is = 1
                        time = 500 * 0.3 * i
                    Case Is = 2
                        time = 300 * 0.3 * i
                    Case Is = 3
                        time = 150 * 0.3 * i
                End Select
            
                Vica = Int(Rnd * Par + 1)
                Vca = Vica \ Ar
                Vra = Vica Mod Ar
                
                If Vra > 0 Then
                    Vca = Vca + 1
                ElseIf Vra = 0 Then
                    Vra = Ar
                End If
                
    'セル色を変数Colに保存する
                Col = Cells(Vra + 3, Vca + 3).Interior.Color
                
                With Cells(Vra + 3, Vca + 3)
                    .Interior.ColorIndex = 6
                    Sleep time
                    .Interior.Color = Col
                End With
                
                Range("F1").Value = "只今の番号は、" & Cells(Vra + 3, Vca + 3) & " です。"
        
            Next i
    '抽選の最後のセル位置を保存する
        Vc = Vca
        Vr = Vra
            
        
        Call Module2.重複当選チェック
        
        With Range("F1")
            .Value = "当選の番号は、" & Cells(Vr + 3, Vc + 3) & " です。"
            .Font.Bold = True
            .Font.Size = 13
        End With
        
        If Jfk = 1 Then
            Zan = 0
        Else
            Zan = 1
        End If
        
        Call Module2.当選者集計

End Sub

MEMO

Rnd関数の使い方についてはこちらを参考にしてください。

Rnd関数で乱数を取得。使えない戻り値を加工して利用度を上げるVBAコード

Int関数の使い方についてはこちらを参考にしてください。

数値の整数部分を完全分離 Int・Fix・Abs・Sign関数で出来る使い方

Select Case ~ End Select ステートメントについてはこの記事を参考にしてください。

Select Case 条件分岐の使い方。ステートメントの基本はコレ。

With~End Withの使い方については、この記事を参考にしてください。

With~End Withの使い方。VBAコードを簡潔に記述する

エクセルVBAのコード処理を指定時間止めるSleep関数

⑤重複当選チェックのプロシージャー

重複当選が無いように設定する部品プロシージャーです。

宣言変数

  • TRange・・・・ 当選者ID表示セル
  • Jf・・・・ 重複当選メッセージの表示を指示する

コード設計のポイント

重複当選メッセージが表示されるたびにコード進行がストップします。

連続抽選の場合は邪魔者になることがありますので、表示しない設定を出来るようにします。

コード

Sub 重複当選チェック()

    Dim TRange As Range    '当選者ID表示セル
        
        Arow = Cells(Rows.Count, 2).End(xlUp).Row
        Set TRange = Range(Cells(11, 3), Cells(Arow, 3))
        
        On Error Resume Next
    'Match関数で、すでにID番号が存在するかどうかを調べる
        MR = WorksheetFunction.Match(Cells(Vr + 3, Vc + 3), TRange, 0)
    '存在する場合としない場合の切り分け
        If MR = 0 Then
            Call 当選番号リストアップ
        ElseIf MR <> 0 Then
        'Jfは重複メッセージを表示するかどうかの分岐指標 Module3で規定
            If Jf = 0 Then
                MsgBox "重複当選がありました。" & vbCrLf & "重複当選番号は、" & Cells(Vr + 3, Vc + 3) & " です。"
            ElseIf Jf = 1 Then
            End If
            
            Cells(Vr + 3, Vc + 3).Interior.ColorIndex = 43
            Jfk = Jfk + 1
            On Error GoTo 0
            MR = 0
        End If

End Sub
MEMO

データ入力済セルの最終行番号取得についてはこちらを参考にしてください。

データ入力済セルの最終行番号を取得するVBAコード

Match関数についてはこの記事を参考にしてください。

エクセルVBAで使うMatch関数 活用度アップでテッパン関数に!

⑥当選番号リストアップのプロシージャー

当選者を表示するための部品プロシージャーです。

宣言変数

  • Vc・・・・ 抽選表のセル位置(列)、 Vr・・・・ 抽選表のセル位置(行)
  • Arow・・・・ B列の最終行、 SYOrow・・・・ A列の最終行
  • Cot・・・・ 当選順位
コード

Sub 当選番号リストアップ()

        With Cells(Vr + 3, Vc + 3)
            .Interior.ColorIndex = 6
        Sleep time
            .Interior.ColorIndex = 43
        End With
        
    '最終行番号の最新のものを再取得する
        Arow = Cells(Rows.Count, 2).End(xlUp).Row
        SYOrow = Cells(Rows.Count, 1).End(xlUp).Row
        
        If Arow = 11 Then
            Cot = 1
        Else
            Cot = Cells(Arow, 2) + 1
        End If
    'リストアップ表示する
        If Range("B" & Arow + 1) = "" Then
            Range("B" & Arow + 1) = Cot
            Range("C" & Arow + 1) = Cells(Vr + 3, Vc + 3)
        ElseIf Range("B" & Arow + 1) <> "" Then
            Range("B" & Arow + 1).Offset(1) = Cot
            Range("C" & Arow + 1).Offset(1) = Cells(Vr + 3, Vc + 3)
        End If
        
        Range("A2").Select
    '上部に現在の当選順位を表示する
        With Range("A2")
            .Value = Cot
            .Font.Bold = True
            .Font.Size = 15
            .Font.ColorIndex = 30
            .Interior.ColorIndex = 44
        End With

End Sub
MEMO

Offsetの使い方はこの記事を参考にしてください。

Offsetプロパティの使い方。セルや選択範囲を移動するVBAコード

⑦当選者集計のプロシージャー

現時点での各賞の当選者数を表示します。

宣言変数

  • PrN()・・・・ 賞名 Module3で規定
  • VName・・・・ 6つの賞名
  • Zan・・・・ 各賞の当選残数
コード

Sub 当選者集計()

         Select Case VName
            Case Is = PrN(1)
                Range("B5") = Range("B5") + Zan
            Case Is = PrN(2)
                Range("B6") = Range("B6") + Zan
            Case Is = PrN(3)
                Range("B7") = Range("B7") + Zan
            Case Is = PrN(4)
                Range("B8") = Range("B8") + Zan
            Case Is = PrN(5)
                Range("B9") = Range("B9") + Zan
            Case Is = PrN(6)
                Range("B10") = Range("B10") + Zan
        End Select

End Sub

抽選の実行プロシージャー「抽選会」のCall呼び出し関係図

全体として、部品プロシージャーをこのように配置しています。

Sub 抽選会()
  ⌊___連続抽選
      ⌊__重複抽選チェック
          ⌊__当選番号リストアップ
      ⌊__当選者集計

  ⌊___単発抽選
      ⌊__重複抽選チェック
          ⌊__当選番号リストアップ
      ⌊__当選者集計
End Sub

抽選の実行コードの組み立て まとめ

抽選の実行について、今回はいろんなパターンを設定しました。

そのため、エクセルVBAコード上の条件分岐が多くなっています。

バリエーションのある抽選方法にしましたので、抽選のイベント性をより高めることが出来ると思います。

たくさんの条件分岐があって、煩雑になってしまうエクセルVBAのコード組み立てでは、

プロシージャーを部品化して本体(親)プロシージャーを整理整頓・簡潔化していきます。

けれどもただ、整理整頓・簡潔化と言っても、

自分(製作者)が、後で修正やメンテナンスしやすいレベルのものにしておくことが重要です。

むやみやたらと整理整頓・簡潔化行ったのでは、実務上逆に分かりずらいものになることがありますので注意が必要です。

短期間でエクセルVBAの独学習得を目指したいなら

エクセルVBAを独学する独習方法は、学習者それぞれ十人十色、多種多様と思われます。

けれども、

出来るだけ効率よく学習するためには、いくつかの大切なポイントがあります。

独学でもVBA習得の中級クラスに達するのはそんなに難しいことではありません。

先人が行った勉強方法をあなたがそのまま利用すればよいということです。

vbastudyeyecatch002 エクセルVBAを独学で習得する!ために大切な7つのポイントを解説します

独習のための大切な7つのポイントは、上記記事にて解説しています。

重要ワード

独習によるVBA習得のキーワードは、

出来るだけ多くの実例に触れること!

です。

正直、VBAの学習について自分の周りの仕事(業務)からだけ実例を得るのでは効率良い習熟は無理です。

ハッキリ言って、

本当に短い期間でVBA習得を成功させたいなら、今使っている参考書が良書かどうかを判断し、新ツールとしてオンライン学習も取り入れて行うことが、

手っ取り早く短期間習得できるというのは間違いないでしょう。

「VBA最速理解」の記事一覧を開く

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

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