読者です 読者をやめる 読者になる 読者になる

年度初日直近の月曜日を割り出すマクロ

ちょい書きマクロです。

年度初日(4月1日)が属する週の月曜日の日付を割り出す必要があって、ちょこちょこっと作ってみた。

f:id:akashi_keirin:20170225221508j:plain

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

f:id:akashi_keirin:20170225225906j:plain

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」と入力すると、

f:id:akashi_keirin:20170225221641j:plain

ほれ、この通り。

「2017」と入力すると、

f:id:akashi_keirin:20170225221459j:plain

ほれ、この通り。

こういう、ちょっとしたマクロを作るのも楽しいね。

@akashi_keirin on Twitter