年度初日直近の月曜日を割り出すマクロ - 素人がExcelVBAによる「一人働き方改革」に挑むブログ

ちょい書きマクロです。

年度初日（４月１日）が属する週の月曜日の日付を割り出す必要があって、ちょこちょこっと作ってみた。

f:id:akashi_keirin:20170225221508j:plain

ワークシートはこんな感じ。

f:id:akashi_keirin:20170225225906j:plain

Ａ３セルにはご覧の通りの書式設定を施しておく、と。

Ａ１セルに、西暦年数を入れたら、Ａ３セルにその年度の４月１日が属する週の月曜日の日付が表示される、という風にしたい。

Ａ１セルの値の変化に連動してマクロが起動すれば良いのだから、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 "西暦年数を４けたの数字で入れよ。"
        .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)の条件に当てはまっていたら、(2)で一旦イベントの発生を止めている。
※一旦Application.EnableEventsをFalseにすると、Trueにするまでの間、
仮にイベントが発生しても無視される。
(3)では、Ａ１セルに入力された値が数値かどうかを判定している。数値でなかったら、メッセージを表示し、
(4)で現在の西暦年数をＡ１セルにセット。
(5)でApplication.EnableEventsをTrueに戻している。
Ａ１セルの値が数値だったら、(6)に来る。ここではＡ１セルの値が1901～2199の間に収まっているかどうかを判定している。
※ここの数字の範囲は、必要に応じて現実的なものにしたら良い。
Ａ１セルの値が範囲内に収まっていなければ、やはりメッセージを表示して現在の年数を入れる。ここでもApplication.EnableEventsをTrueにするのを忘れないように。
上記２つの条件をかいくぐってきたら、(7)に来る。
(8)で変数tmpDateにＡ１セルに入力した年の４月１日のシリアル値を代入。
(9)は後述のFunctionプロシージャ。４月１日直前の月曜日のシリアル値を返す。
(10)でＡ３セルに(9)で取得した日付のシリアル値を記入。
もちろん、最後にApplication.EnableEventsをTrueにするのを忘れないように。

とまあ、こんな感じ。

で、肝腎の４月１日直前の日付を求めるロジックはコチラ。

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)で、日付のシリアル値から１を引く。すなわち、１日前の日付にする。
日付の曜日が月曜日になった時点でループを抜け、(3)でその日付をsearchMondayの戻り値として元のプロシージャに返す。
※ここでは、上のリストの(9)で変数tmpDateに日付を代入することになる。

Ａ１セルに「2014」と入力すると、

f:id:akashi_keirin:20170225221641j:plain