年度初日直近の月曜日を割り出すマクロ
ちょい書きマクロです。
年度初日(4月1日)が属する週の月曜日の日付を割り出す必要があって、ちょこちょこっと作ってみた。
ワークシートはこんな感じ。
A3セルにはご覧の通りの書式設定を施しておく、と。
A1セルに、西暦年数を入れたら、A3セルにその年度の4月1日が属する週の月曜日の日付が表示される、という風にしたい。
A1セルの値の変化に連動してマクロが起動すれば良いのだから、VBAのコードはSheet1のモジュールに記述することになる。
Private Sub Worksheet_Change(ByVal Target As Range)
Dim tmpDate As Date
With Target
If .Row = 1 And .Column = 1 Then '……(1)
Application.EnableEvents = False '……(2)
If IsNumeric(.Value) = False Then '……(3)
MsgBox "西暦年数を4けたの数字で入れよ。"
.Value = Year(Now()) '……(4)
Application.EnableEvents = True '……(5)
Exit Sub
ElseIf .Value < 1900 Or .Value > 2200 Then '……(6)
MsgBox "現実的な西暦年数を入れよ。"
.Value = Year(Now())
Application.EnableEvents = True
Exit Sub
Else '……(7)
tmpDate = DateSerial(.Value, 4, 1) '……(8)
tmpDate = searchMonday(tmpDate) '……(9)
ThisWorkbook.Worksheets("Sheet1").Range("A3").Value = tmpDate '……(10)
Application.EnableEvents = True
End If
End If
End With
End Sub
上記リストの(9)のところで、「searchMonday」というFunctionプロシージャを呼び出しているが、そのリストは後で。
Sheet1モジュールのWorksheet_Changeプロシージャにコードを書いていく。Worksheetオブジェクトの「Change」というイベントをきっかけに駆動するプロシージャだと理解しておけば良い。「Change」は「セルの値が変わった」というイベントのこと。以下、コードの説明。
- (1)で、Targetの行番号が1、かつ列番号が1、すなわち値が変わったセルがA1セルだったら、という条件を指定し、
- (1)の条件に当てはまっていたら、(2)で一旦イベントの発生を止めている。
※一旦Application.EnableEventsをFalseにすると、Trueにするまでの間、
仮にイベントが発生しても無視される。 - (3)では、A1セルに入力された値が数値かどうかを判定している。数値でなかったら、メッセージを表示し、
- (4)で現在の西暦年数をA1セルにセット。
- (5)でApplication.EnableEventsをTrueに戻している。
- A1セルの値が数値だったら、(6)に来る。ここではA1セルの値が1901~2199の間に収まっているかどうかを判定している。
※ここの数字の範囲は、必要に応じて現実的なものにしたら良い。 - A1セルの値が範囲内に収まっていなければ、やはりメッセージを表示して現在の年数を入れる。ここでもApplication.EnableEventsをTrueにするのを忘れないように。
- 上記2つの条件をかいくぐってきたら、(7)に来る。
- (8)で変数tmpDateにA1セルに入力した年の4月1日のシリアル値を代入。
- (9)は後述のFunctionプロシージャ。4月1日直前の月曜日のシリアル値を返す。
- (10)でA3セルに(9)で取得した日付のシリアル値を記入。
- もちろん、最後にApplication.EnableEventsをTrueにするのを忘れないように。
とまあ、こんな感じ。
で、肝腎の4月1日直前の日付を求めるロジックはコチラ。
Private Function searchMonday(ByVal tmpDate_ As Date) As Date
Do While Weekday(tmpDate_) <> vbMonday '……(1)
tmpDate_ = tmpDate_ - 1 '……(2)
Loop
searchMonday = tmpDate_ '……(3)
End Function
- (1)で、Weekday関数の戻り値がVbMondayでなければ繰り返す、と繰り返し条件を設定。
※もちろん、引数として渡した日付の曜日が月曜日だったら、中身を一度も実行せずにループを抜けることになる。 - (2)で、日付のシリアル値から1を引く。すなわち、1日前の日付にする。
- 日付の曜日が月曜日になった時点でループを抜け、(3)でその日付をsearchMondayの戻り値として元のプロシージャに返す。
※ここでは、上のリストの(9)で変数tmpDateに日付を代入することになる。
A1セルに「2014」と入力すると、
ほれ、この通り。
「2017」と入力すると、
ほれ、この通り。
こういう、ちょっとしたマクロを作るのも楽しいね。