(Excelマクロ)土日祝を除いて計算する
基準日の前後で、土日祝を除いた日付を返すマクロです。このマクロは基準日の日付が変更された場合に実行されます。
なお、ある期間の土日祝を除いた日数を求めたい場合は、「NETWORKDAYS」関数が便利です。
基準日の上下にある数字は、「その基準日より何日前の日付か」を示します。「-5日」のようにしたい場合は、セルの値をいじるのではなく、下の画像のようにセルの書式設定で「日」の表記を追加してください。
祝日シート
下図のようにA列に日付が入っていればOKです。土日の祝日が入っていても問題ありません。
シートモジュールのコード
対象シートのシートモジュールに以下のコードを記述します。
Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column = 1 Then Exit Sub If Target.Offset(0, -1).Value = BASEWORD Then Call 祝日処理 End Sub
コード5行目で左隣の列を参照します。A列の値を変更した場合はエラーになりますので、コード4行目でA列の値を変更した場合は処理を終了しています。
標準モジュールのコード
標準モジュールに以下のコードを記述します。100行以上ありますので、解説は分けて付けます。
Option Explicit Public Const Saturday As Long = 6 Public Const Sunday As Long = 7 Public Const BASEWORD As String = "基準日" Public AN_DAYS() As Date Public Sub 祝日処理() '変数定義--------------------------- Dim cnt As Long, tmp As Long Dim lastrow As Long Dim BASEDAY As Date, BASEROW As Long Dim SRange As Range '祝日取得------------------------------------ cnt = 1 ''配列AN_DAYSの初期値を1に設定 With Sheets("2018祝日") For Each SRange In .Range(.Cells(1, 1), .Cells(.Range("A100").End(xlUp).Row, 1)) ReDim Preserve AN_DAYS(cnt) AN_DAYS(cnt) = SRange.Value cnt = cnt + 1 Next End With '基準日取得---------------------------------------- With Sheets(1) Set SRange = .Range("A1:A100").Find(What:=BASEWORD) lastrow = .Range("A100").End(xlUp).Row If SRange Is Nothing Then MsgBox "A列に" & BASEWORD & "の文字列が見つかりません " Exit Sub Else With SRange BASEDAY = .Offset(0, 1).Value BASEROW = .Row End With End If '祝日処理---------------------------------------- For Each SRange In .Range(.Cells(1, 1), .Cells(lastrow, 1)) With SRange If .Value = BASEWORD Then GoTo skip tmp = Abs(.Value) Select Case .Row Case Is < BASEROW '基準日より前 Call 共通ルーチン(TARGET_RANGE:=SRange, TARGET_DAY:=BASEDAY, LOOP_COUNT:=tmp, CntNum:=-1) Case Is > BASEROW '基準日より後 Call 共通ルーチン(TARGET_RANGE:=SRange, TARGET_DAY:=BASEDAY, LOOP_COUNT:=tmp, CntNum:=1) End Select End With skip: Next End With Set SRange = Nothing End Sub Private Sub 共通ルーチン(ByVal TARGET_RANGE As Range, _ ByVal TARGET_DAY As Date, _ ByVal LOOP_COUNT As Long, _ ByVal CntNum As Long) Dim i As Long Do TARGET_DAY = TARGET_DAY + CntNum Do '土日判定------------------------- Select Case Weekday(TARGET_DAY, vbMonday) Case Saturday If CntNum > 0 Then TARGET_DAY = TARGET_DAY + (CntNum * 2) Else TARGET_DAY = TARGET_DAY + CntNum End If Case Sunday If CntNum > 0 Then TARGET_DAY = TARGET_DAY + CntNum Else TARGET_DAY = TARGET_DAY + (CntNum * 2) End If End Select '祝日判定------------------------- Select Case CntNum Case Is < 0 For i = UBound(AN_DAYS) To LBound(AN_DAYS) Step CntNum If TARGET_DAY = AN_DAYS(i) Then TARGET_DAY = TARGET_DAY + CntNum Next i Case Else For i = LBound(AN_DAYS) To UBound(AN_DAYS) Step CntNum If TARGET_DAY = AN_DAYS(i) Then TARGET_DAY = TARGET_DAY + CntNum Next i End Select Loop While Weekday(TARGET_DAY, vbMonday) >= Saturday LOOP_COUNT = LOOP_COUNT - 1 Loop Until LOOP_COUNT = 0 TARGET_RANGE.Offset(0, 1).Value = TARGET_DAY End Sub
祝日処理のコード解説
変数定義まで
Option Explicit Public Const Saturday As Long = 6 Public Const Sunday As Long = 7 Public Const BASEWORD As String = "基準日" Public AN_DAYS() As Date Public Sub 祝日処理() '変数定義--------------------------- Dim cnt As Long, tmp As Long Dim lastrow As Long Dim BASEDAY As Date, BASEROW As Long Dim SRange As Range
2~5行目は複数のモジュールで使用する共通定数・変数です。
祝日取得
'祝日取得------------------------------------ cnt = 1 ''配列AN_DAYSの初期値を1に設定 With Sheets("2018祝日") For Each SRange In .Range(.Cells(1, 1), .Cells(.Range("A100").End(xlUp).Row, 1)) ReDim Preserve AN_DAYS(cnt) AN_DAYS(cnt) = SRange.Value cnt = cnt + 1 Next End With
祝日シートのA列について、動的配列AN_DAYSに1日ずつ格納します。For Nextで処理しても構いません。
基準日取得
'基準日取得---------------------------------------- With Sheets(1) Set SRange = .Range("A1:A100").Find(What:=BASEWORD) lastrow = .Range("A100").End(xlUp).Row If SRange Is Nothing Then MsgBox "A列に" & BASEWORD & "の文字列が見つかりません " Exit Sub Else With SRange BASEDAY = .Offset(0, 1).Value BASEROW = .Row End With End If
2行目で、一番左にあるシートを対象にしています。Sheets(“Sample”)のように記述しても構いません。
3行目で、A列の1行目~100行目の中でBASEWORD(=基準日)と書かれたセルを探します。見つからない場合はエラーとなります。
10~12行目で、基準日の日付と基準日がある行の位置を取得します。
基準日取得他
'祝日処理---------------------------------------- For Each SRange In .Range(.Cells(1, 1), .Cells(lastrow, 1)) With SRange If .Value = BASEWORD Then GoTo skip tmp = Abs(.Value) Select Case .Row Case Is < BASEROW '基準日より前 Call 共通ルーチン(TARGET_RANGE:=SRange, TARGET_DAY:=BASEDAY, LOOP_COUNT:=tmp, CntNum:=-1) Case Is > BASEROW '基準日より後 Call 共通ルーチン(TARGET_RANGE:=SRange, TARGET_DAY:=BASEDAY, LOOP_COUNT:=tmp, CntNum:=1) End Select End With skip: Next End With Set SRange = Nothing End Sub
5行目は、A列の数字を絶対値に変換しています。
7~10行目で、別のプロシージャである共通ルーチンを呼び出します。このとき、対象セルの値がプラスかマイナスかで、引数CntNumに指定する数値が変わります。
共通ルーチンのコード解説
土日判定
Private Sub 共通ルーチン(ByVal TARGET_RANGE As Range, _ ByVal TARGET_DAY As Date, _ ByVal LOOP_COUNT As Long, _ ByVal CntNum As Long) Dim i As Long Do TARGET_DAY = TARGET_DAY + CntNum Do '土日判定------------------------- Select Case Weekday(TARGET_DAY, vbMonday) Case Saturday If CntNum > 0 Then TARGET_DAY = TARGET_DAY + (CntNum * 2) Else TARGET_DAY = TARGET_DAY + CntNum End If Case Sunday If CntNum > 0 Then TARGET_DAY = TARGET_DAY + CntNum Else TARGET_DAY = TARGET_DAY + (CntNum * 2) End If End Select
8行目について、基準日より前ならば前日にさかのぼり、基準日より後ならば翌日に進みます。
13行目~24行目は土日の判定です。14行目・15行目と20行目・21行目は基準日より後の場合の処理、16行目・17行目と22行目・23行目は基準日より前の場合の処理です。
基準日より後の場合は、土曜日ならば月曜日に進む必要がありますのでプラス2日とします。基準日より前の場合は、日曜日ならば金曜日に進む必要がありますのでマイナス2日とします。プラス1日については祝日が土曜日の場合、マイナス1日については祝日が月曜日の場合に実行される例外的な処理です。
祝日判定
'祝日判定------------------------- Select Case CntNum Case Is < 0 For i = UBound(AN_DAYS) To LBound(AN_DAYS) Step CntNum If TARGET_DAY = AN_DAYS(i) Then TARGET_DAY = TARGET_DAY + CntNum Next i Case Else For i = LBound(AN_DAYS) To UBound(AN_DAYS) Step CntNum If TARGET_DAY = AN_DAYS(i) Then TARGET_DAY = TARGET_DAY + CntNum Next i End Select Loop While Weekday(TARGET_DAY, vbMonday) >= Saturday LOOP_COUNT = LOOP_COUNT - 1 Loop Until LOOP_COUNT = 0 TARGET_RANGE.Offset(0, 1).Value = TARGET_DAY End Sub
4~6行目は基準日より前の場合の処理、8~10行目は基準日より後の場合の処理です。
基準日より前に遡る場合は、祝日を後ろから数える必要があります。前から数えてしまうと、GWのように祝日が続くところで祝日判定にミスが発生します。例として、5/7(月)を基準日とし、1日前の平日を調べるとき、5/5の祝日はカウントされて1日戻りますが、5/4(金)は土曜日でも日曜日でもないため、13行目のループ条件を満たさず、5/4が平日として表示されてしまいます。
まとめ
上記のコードを応用することによって、1年間のスケジュールの日付を自動設定する・指定土曜日を平日として数える等も簡単にできるようになります。
最近のコメント