入力事項を保存してユーザーフォームの利便性を上げる-抽選ソフト作成5

tyusenbackupeyecatch

ユーザーフォームに項目記入しても、一旦非表示にしてしまうと、
再表示時には、入力した項目がすべてクリアされていることにショックを感じます。
バックアップ対策で表示復旧を簡単に行えるようにします。

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

 

今回のエクセルVBA抽選ソフト作成5の解説は、

「ユーザーフォーム」に記入した事項をバックアップ保存するためのコードの作成についてです。

 

一つ前の記事を読み返すのはこちら↓からになります。

tyusencomopteyecatchコマンドボタンで実行するプロシージャーに紐づけのコードを作る-抽選ソフト作成4

 

ユーザーフォームの入力事項を保存する理由

 

ユーザーフォームの入力項目を、なぜバックアップする必要があるのか?

理由は単純明快です。ユーザーフォームは非表示になるからです。

つまり、ユーザーフォームが一旦非表示になると、

それまでセットしていたユーザーフォームの入力事項がすべてクリアされてしまうのです。

するとどうなるか?

ユーザーフォームを使うためには再度1から項目入力しなければなりません。

もしユーザーフォームが非表示ななる前に、

入力事項がプログラムに値として取り込まれていたら

更にそのエクセル本体を終了していなければ、入力値としては保持されてはいます。

(この場合でもユーザーフォームの非表示原因がプログラムコードエラーなら、入力値としても保存されませんが・・・)

 

こんな面倒なことが起こってしまうことが、入力事項をバックアップしておきたいという理由です。

 

ユーザーフォームの入力事項の保存の流れ

 

抽選項目BUシートに、ユーザーフォームの入力事項を転記します。

 

「抽選項目登録」ボタンの場合

ユーザーフォームの「抽選項目登録」ボタンが押されたとき、入力項目の値が変数に代入されるのと同時に、

Module4に記述されている「抽選項目バックアップ」プロシージャーで、

入力項目データを抽選項目BUシートに転記します。

この「抽選項目登録」ボタンをクリックしたときは、新しいバックアップとしてそれまでのデータがリセットされます。

 

「抽選項目更新」ボタンの場合

ユーザーフォームの「抽選項目更新」ボタンが押されたときは、

Module4に記述されている「抽選項目バックアップ旧データ」プロシージャーによって、

抽選項目BUシート上で、先の「抽選項目登録」の時にバックアップされた入力項目データを下方向に移動します。

更に、今、入力されているユーザーフォームの入力項目をバックアップ位置に転記します。

Module4に記述されている「抽選項目更新」プロシージャーによって、

更新された項目を含めて、再度、抽選項目が変数に代入され変数値が更新されます。

抽選状況一覧において、賞名が更新された新しい賞名に変更されます。

 

「抽選方法12か所」ボタンの場合

各賞の「単発」と「連続」ボタンを押して抽選を行った時にも

「抽選項目更新」ボタンを押したときと同じバックアップが行われます。

常に最新の状況としてバックアップします。

 

バックアップ関連のプロシージャーの内容

 

Module4に記述していきます。

「抽選項目バックアップ」プロシージャー

 

tyusenbackup001a

 

宣言変数

  • i、j・・・・ カウンター変数
  • BUsheet・・・・ 抽選項目BUシート
  • Title・・・・ 抽選名称
  • Par・・・・ 参加人数(口)
  • EVD・・・・ 開催日付
  • PrN()・・・・ 賞名
  • PrQ()・・・・ 当選本数

抽選項目BUシートのA列からC列、1から10行目にバックアップを作ります。

コード


Sub 抽選項目バックアップ()

    Dim i, j As Long
    
        Set BUsheet = Worksheets("抽選項目BU")
        BUsheet.Select
        Cells.Clear
        
        For i = 101 To 109
           Cells(1, 1) = "抽選項目"
           Cells(1, 2) = "設定値"
           Cells(1, 3) = "当選本数"
           Cells(i - 100 + 1, 1) = 選定ナビ.Controls("Label" & i).Caption
        Next i
           
        Range("B2") = TItle
        Range("B3") = Par
        Range("B4") = EVD
        
        For j = 1 To 6
            Range("B" & 4 + j) = PrN(j)
            Range("C" & 4 + j) = PrQ(j)
        Next j
        
        Columns("A:C").AutoFit
End Sub

 

「抽選項目バックアップ旧データ」プロシージャー

 

tyusenbackup002a

 

宣言変数

  • i・・・・ カウンター変数
  • BUsheet・・・・ 抽選項目BUシート
  • TYsheet・・・・ 抽選会場シート

抽選会場シートのセルA1が「空白」の場合はプロシージャーを実行しません。
(セルA1が空白になっているの状態は、この抽選ソフトが使われていない初期の状態の時です。)

「賞名」がデフォルトの「(仮)賞」も入力されていない状態の時があれば、

デフォルトの「(仮)賞」を強制表示させるプロシージャー「賞名空白対処」を呼び出します。

コード


Sub 抽選項目バックアップ旧データ()

    Dim i As Long
    
        Set BUsheet = Worksheets("抽選項目BU")
        Set TYsheet = Worksheets("抽選会場")
        
        TYsheet.Select
        If Range("A1") = "" Then Exit Sub
        
        BUsheet.Select
        
        Call Module4.賞名空白対処
        
        For i = 1 To 10
            Range("A" & 12 + i) = "旧 " & Range("A" & i)
            Range("B" & 12 + i) = Range("B" & i)
            Range("C" & 12 + i) = Range("C" & i)
        Next i
        
        Range("B2") = 選定ナビ.抽選名称.Value
        Range("B3") = 選定ナビ.参加人数.Value
        Range("B4") = 選定ナビ.開催日付.Value
        
        Range("B5") = 選定ナビ.一位賞.Value
        Range("B6") = 選定ナビ.二位賞.Value
        Range("B7") = 選定ナビ.三位賞.Value
        Range("B8") = 選定ナビ.四位賞.Value
        Range("B9") = 選定ナビ.五位賞.Value
        Range("B10") = 選定ナビ.六位賞.Value
        
        Range("C5") = 選定ナビ.一位本.Value
        Range("C6") = 選定ナビ.二位本.Value
        Range("C7") = 選定ナビ.三位本.Value
        Range("C8") = 選定ナビ.四位本.Value
        Range("C9") = 選定ナビ.五位本.Value
        Range("C10") = 選定ナビ.六位本.Value
        
        Columns("A:C").AutoFit

End Sub
VBAコード参考記事

ここの説明で出てくるVBAコードの参考にしていただける記事です。

 

「抽選項目更新」プロシージャー

 

宣言変数

  • i、j、k・・・・ カウンター変数
  • FArow・・・・ 抽選会場シートの抽選一覧表の賞名列の最終行
  • BUsheet・・・・ 抽選項目BUシート
  • TYsheet・・・・ 抽選会場シート
  • Title・・・・ 抽選名称
  • Par・・・・ 参加人数(口)
  • EVD・・・・ 開催日付
  • PrN()・・・・ 賞名
  • PrQ()・・・・ 当選本数
  • PrQn()・・・・ 当選本数(数値型)

抽選一覧表の賞名のさかのぼり修正は、

抽選項目バックアップの賞名の新旧を比較して差異がある場合は、

旧賞名を新賞名に置き換えるという作業を行っています。

コード


Sub 抽選項目更新()
    Dim i, j, k As Long
    Dim FArow As Long
    
        Set BUsheet = Worksheets("抽選項目BU")
        Set TYsheet = Worksheets("抽選会場")
        
        TYsheet.Select
        If Range("A1") = "" Then Exit Sub
        
        BUsheet.Select
        TItle = Range("B2")
        Par = Range("B3")
        EVD = Range("B4")
                
        Call Module4.賞名空白対処
                
        For i = 1 To 6
            PrN(i) = Range("B" & 4 + i)
            PrQ(i) = Range("C" & 4 + i)
            PrQn(i) = Val(StrConv(PrQ(i), vbNarrow))
            TYsheet.Range("C" & 4 + i) = PrQn(i) - TYsheet.Range("B" & 4 + i)
        Next i
                
        TYsheet.Select
        If Range("A1") = "" Then
            Range("C:C").ClearContents
        End If
        For j = 1 To 6
            TYsheet.Range("A" & 4 + j) = BUsheet.Range("B" & 4 + j)
        Next j
            
    '抽選会場当選結果、賞名のさかのぼり修正
        FArow = TYsheet.Cells(Rows.Count, 1).End(xlUp).Row
        BUsheet.Select
        For j = 1 To 6
            If Range("B" & 4 + j) <> Range("B" & 16 + j) Then
            
                For k = 12 To FArow
                    If TYsheet.Range("A" & k) = BUsheet.Range("B" & 16 + j) Then
                        TYsheet.Range("A" & k) = BUsheet.Range("B" & 4 + j)
                    End If
                Next k
            
            End If
        
        Next j
        TYsheet.Select

End Sub

 

MEMO

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

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

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

vbacalleyecatch部品化プロシージャーでCallステートメントは必須

If条件文についてはこちらを参考にしてください。

vbaifjyokeneyecatch「If条件文」のVBAコードの組み方。条件の絞り方を最速に理解。

StrConv関数の使い方

 

「賞名空白対処」プロシージャー

 

宣言変数

  • i・・・・ カウンター変数

それぞれの賞名が空欄で、かつ当選本数が入力されている場合に「(仮)賞」をユーザーフォームのテキストボックスに表示します。

コード


Sub 賞名空白対処()

    Dim i As Long
    
        For i = 1 To 6
        
            If 選定ナビ.一位賞.Value = "" And 選定ナビ.一位本.Value <> "" Then
                        選定ナビ.一位賞.Value = "(仮)1位賞"
            ElseIf 選定ナビ.二位賞.Value = "" And 選定ナビ.二位本.Value <> "" Then
                        選定ナビ.二位賞.Value = "(仮)2位賞"
            ElseIf 選定ナビ.三位賞.Value = "" And 選定ナビ.三位本.Value <> "" Then
                        選定ナビ.三位賞.Value = "(仮)3位賞"
            ElseIf 選定ナビ.四位賞.Value = "" And 選定ナビ.四位本.Value <> "" Then
                        選定ナビ.四位賞.Value = "(仮)4位賞"
            ElseIf 選定ナビ.五位賞.Value = "" And 選定ナビ.五位本.Value <> "" Then
                        選定ナビ.五位賞.Value = "(仮)5位賞"
            ElseIf 選定ナビ.六位賞.Value = "" And 選定ナビ.六位本.Value <> "" Then
                        選定ナビ.六位賞.Value = "(仮)6位賞"
            End If
        
        Next i

End Sub

 

「当選者リスト作成」プロシージャー

 

tyusenbackup003a

 

バックアップ関連でModule4に「当選者リスト作成」プロシージャーを記述します。

当選者シートに当選者リストをコピーでバックアップします。

当選者リストを作成する度に、前回作成分に上書きされます。

ソフトの「強制初期化」を行うと当選者シートそのものがクリアされます。

安全に保存するためには、別のエクセルファイルに内容をコピー保存してください。

コード


Sub 当選者リスト作成()

    Dim LCRow As Long
    
        Set TYsheet = Worksheets("抽選会場")
        Set TOsheet = Worksheets("当選者")
        
        If TYsheet.Range("A1") = "" Then Exit Sub
        
        TOsheet.Select
        Cells.Clear
        
        TYsheet.Select
        LCRow = TYsheet.Cells(Rows.Count, 3).End(xlUp).Row
        
        Range(Cells(3, 1), Cells(LCRow, 3)).Copy TOsheet.Range("A3")
        TOsheet.Select
        
        With TOsheet
            .Columns("A:C").AutoFit
            .Range("A1") = TItle '選定ナビ.抽選名称.Value
            .Range("C1") = EVD '選定ナビ.開催日付.Value
            .Range("A2") = Par & "人(口)" '選定ナビ.参加人数.Value & "人(口)"
        
            With .Range("A1,A2,C1").Font
                .Bold = True
                .Size = 13
            End With
        
        End With
        
        TYsheet.Select

End Sub

 

MEMO

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

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

With~End Withについてはこちらを参考にしてください。

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

 

ユーザーフォームの入力項目をバックアップ のまとめ

 

ユーザーフォームを非表示にしてしまうと、再表示時には入力した項目がすべてクリアされています。
(このソフトでは、デフォルトで「(仮)賞」がテキストボックスに表示されるようになっています。)

「抽選項目登録」や「抽選項目更新」を行っていた場合は、

「抽選名称復旧」や「抽選項目復旧」ボタンで状態を前に戻すことが出来ます。

 

結構あれば便利な機能です。

 

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

 

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

けれども、

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

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

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

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

重要ワード

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

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

です。

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

ハッキリ言って、

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

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

 

「エクセルVBA最速理解」の記事一覧を開く

 

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

 

 

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