さて、7月に投稿30回すると息巻いてみたものの全然達成できなかった、たかまいです。
できなかった理由は次回以降のブログに記載するとして、
元々やろうと思っていた内容については今後のブログで記載していきます。
さて今回はちょうど1ヶ月前VBAを使用して予約台帳をしやすくするペアプロの準備編について書きました。
前回から子供が熱を出したり、バスケしたり、旅行したりその上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型でデータを配列で格納します。（この辺の理解はあいまいです💦）
ｓ_today（当日用フォームシート）のA4を起点とした範囲を一行分下に下げて値を取得します。
そして、配列で取得したデータをs_end（終了したデータ）にコピーします。
当日フォームクリア
次にもう不要となっている当日フォームをクリアします。
これは標準モジュールではなく、シートモジュールにいれています。
特別にシートをまたぐ作業でないときにはコードが読みやすくなるので、今回のようなシンプルなコードにはわかりやすいとのこと。
実際Withが入るだけで混乱する私には、とても見やすいコードになりました。
コードはこちら
Sub 当日フォームクリア()
Range("A4").CurrentRegion.Offset(1, 0).ClearContents
End Sub
これは私もわかりました。A4セルを起点とした範囲取得をしてそこから１行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 SubCells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
⇒これで最終行から２行目まで逆順で下から調べますよというコード。
通常の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 Subarrを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シートに予約台帳を全データを一旦貼り付けます。
その後最終行から上の行に順番に
「もし２列目の日付が今日の日付の翌日でない場合に行を削除する」
ということをします。
そうすることで、明日のデータだけがs_todayシートに残るような状態です。
一括処理するプロシージャを作成する。
一つずつ順を追って処理をしてもいいですが、自動化のためには一括処理をしていきます。
一つずつのプロシージャをCallで呼び出します。
コードはこちら
Sub 一括処理()
'これは事前処理
Call 終了データに移動
Call s_today.当日フォームクリア
Call s_data.予約台帳クリア
' これが本処理です
Call s_data.SortDate
Call 配列作成
Call 当日用フォーム作成
End Sub処理がわかるようにコメントアウトして、事前処理と本処理をわかりやすくすることで、
後に自分が見てもわかるようになっています。
これにより予約台帳だけでなく様々なものでのコピペの応用ができそうです！！
ぜひ皆さんもやってみてください！
コメント