VBAを使用して、予約台帳を使用しやすくするペアプロ〜完成編〜

さて、7月に投稿30回すると息巻いてみたものの全然達成できなかった、たかまいです。
できなかった理由は次回以降のブログに記載するとして、
元々やろうと思っていた内容については今後のブログで記載していきます。


さて今回はちょうど1ヶ月前VBAを使用して予約台帳をしやすくするペアプロの準備編について書きました。

あわせて読みたい
VBAを使用して予約台帳を使用しやすくするペアプロ~準備編~ こんにちは、たかまいです。7月にブログを30回投稿を決めた今回は6回目の投稿です。前回はこちら https://brogbungprog.com/2022/07/17/%e7%8f%be%e5%9c%a8%e3%81%ae%e3...

前回から子供が熱を出したり、バスケしたり、旅行したりその上Pythonの勉強始めたら
VBAが混乱するレベルで理解力が下がり、コード入力画面で呆然としてペアプロ当日を迎えました。

そんな中、優しく向き合ってくださったichifukuさん(@sayumifu)に大感謝!

それでは行ってみましょう!

目次

行いたい作業の流れ確認

予約がきたら予約台帳に入力。

こちらについては電話やHPから予約が来たら台帳に随時反映していきます。
台帳はこんな感じです。


このように随時増えていくようなテーブルを使用します。

予約日前日に翌日分を印刷できるシートを作成する。

マクロを実行したら翌日予約者が台帳に移動するマクロです。

当日が終わったら終了分リストへ移動。

終了分が終了したデータに移動します。

また翌日リストの作成へ…

という流れです。

それではそれをマクロを作成して実行していきます。

VBAで実行するための手順とコード

終了データに移動

ルーティンワークの最初の手順は翌日印刷台帳を作成するために、
現在印刷台帳に残っているデータを終了分に移動させます。
そのためのコードがこちら

Sub 終了データに移動()
    arr = s_today.Range("A4").CurrentRegion.Offset(1, 0).Value
    
    Dim lastRow As Long
    lastRow = s_end.Cells(Rows.Count, 1).End(xlUp).Row
    
    With s_end
        .Range(.Cells(lastRow + 1, 1), .Cells(UBound(arr) + 1, 9)).Value = arr
    End With
End Sub

arrの型はvariant型でデータを配列で格納します。(この辺の理解はあいまいです💦)
s_today(当日用フォームシート)のA4を起点とした範囲を一行分下に下げて値を取得します。

そして、配列で取得したデータをs_end(終了したデータ)にコピーします。

当日フォームクリア

次にもう不要となっている当日フォームをクリアします。
これは標準モジュールではなく、シートモジュールにいれています。
特別にシートをまたぐ作業でないときにはコードが読みやすくなるので、今回のようなシンプルなコードにはわかりやすいとのこと。
実際Withが入るだけで混乱する私には、とても見やすいコードになりました。

コードはこちら


Sub 当日フォームクリア()
    Range("A4").CurrentRegion.Offset(1, 0).ClearContents
    
End Sub

これは私もわかりました。A4セルを起点とした範囲取得をしてそこから1行offsetしたデータをクリアするというもの

予約台帳過去分をクリア

予約台帳も過去のものがずっとあるとわかりづらいので終了分に移動したらもう必要ありません。
そちらをクリアしていきます。こちらもシートモジュールでs_data(予約台帳シート)の過去分をクリアします。
コードはこちら

Sub 予約台帳クリア()
    Dim i As Long
    For i = Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
        If Cells(i, 2).Value <= Date Then
           Rows(i).Delete
        End If
    Next i
        
End Sub

Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
⇒これで最終行から2行目まで逆順で下から調べますよというコード。

通常のfor 文はStep 1 というのが省略されています。
ちなみに一つおきにしらべたいときなどはStep 2 でできるようです。

あとはDate関数は今日の日付の取得ができるので
今日以前のデータが描かれている行を削除する。という文になりますね。
これで無事今日以前の予約台帳が消えました。
行削除する際には下から逆順で調べることで、行番号がずれないとのこと( ..)φメモメモ

予約台帳の日付を並べ替える。

Sub SortDate()
    With Sort
        .SortFields.Clear
        .SortFields.Add Key:=Range("B1"), Order:=xlAscending
        .SortFields.Add Key:=Range("D1"), Order:=xlAscending
        .SetRange Range("A1").CurrentRegion
        .Header = xlYes
        .Apply
     
   
    End With
End Sub

予約台帳の日付を昇順で並べ替えます(B1セル)。
日付を並び替えた後、時間を昇順で並べ替えます(D1セル)。

SetRangeでSortする範囲を指定して先頭行をヘッダーに指定します。

予約台帳の内容を配列作成する。

標準モジュールに配列を作成していきます。

Sub 配列作成()
        arr = s_data.Range("A1").CurrentRegion.Value
End Sub

arrをVariant型で指定したのでarrを配列に入れます。

当日用フォーム作成

最後に予約台帳の配列取得したものを、s_today(当日フォームシート)に移動します。
こちらは、標準モジュールに記載しています。
コードはこちら。

Sub 当日用フォーム作成()
    With s_today
        .Range(.Cells(4, 1), .Cells(UBound(arr) + 3, 9)).Value = arr
        
        Dim i As Long
        For i = .Cells(Rows.Count, 1).End(xlUp).Row To 5 Step -1
            If .Cells(i, 2).Value <> Date + 1 Then
                .Rows(i).Delete
            End If
        Next i
    End With
    
End Sub

s_todayシートに予約台帳を全データを一旦貼り付けます。
その後最終行から上の行に順番に
もし2列目の日付が今日の日付の翌日でない場合に行を削除する
ということをします。
そうすることで、明日のデータだけがs_todayシートに残るような状態です。

一括処理するプロシージャを作成する。

一つずつ順を追って処理をしてもいいですが、自動化のためには一括処理をしていきます。
一つずつのプロシージャをCallで呼び出します。
コードはこちら

Sub 一括処理()
'これは事前処理
    Call 終了データに移動
    Call s_today.当日フォームクリア
    Call s_data.予約台帳クリア
    
'    これが本処理です
    Call s_data.SortDate
    Call 配列作成
    Call 当日用フォーム作成
    
End Sub

処理がわかるようにコメントアウトして、事前処理と本処理をわかりやすくすることで、
後に自分が見てもわかるようになっています。

これにより予約台帳だけでなく様々なものでのコピペの応用ができそうです!!
ぜひ皆さんもやってみてください!

よかったらシェアしてね!
  • URLをコピーしました!
  • URLをコピーしました!

この記事を書いた人

VBAを身に着けたい運動指導者
ノンプロ研にはまっています

コメント

コメントする

目次
閉じる