（Excelマクロ）土日祝を除いて計算する

by · 公開済み · 更新済み

基準日の前後で、土日祝を除いた日付を返すマクロです。このマクロは基準日の日付が変更された場合に実行されます。
なお、ある期間の土日祝を除いた日数を求めたい場合は、「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年間のスケジュールの日付を自動設定する・指定土曜日を平日として数える等も簡単にできるようになります。

タグ:

おすすめ

コメントを残す

メールアドレスが公開されることはありません。

このサイトはスパムを低減するために Akismet を使っています。コメントデータの処理方法の詳細はこちらをご覧ください。