【ExcelVBA】祝日を加味して営業日を調べる方法

# はじめに

業務用のちょっとしたツールを作っていると、「その月の最終営業日はいつなのか？」「〇〇日は営業日か？」といったことを判定できるプログラムが欲しくなる時があります。

「平日であるか？」ということを調べるのであれば簡単なのですが、祝日を踏まえた上で「営業日であるか？」ということを調べるのは少々面倒です。
なぜ営業日を調べるのが面倒なのかというと、「一部の祝日の日付が年によって変わるため、営業日であるかの判定が年ごとに変わってしまう」というのが大きな理由です。

そこで今回は「[内閣府の祝日CSV](https://www8.cao.go.jp/chosei/shukujitsu/gaiyou.html)」を使って、営業日を調べるプログラムを作ってみました。

## DateCheckerクラス

* 営業日を求めるためのメイン処理となるクラスモジュールです。
* [内閣府の祝日CSV](https://www8.cao.go.jp/chosei/shukujitsu/gaiyou.html)をダウンロードして、CSVから取得した祝日を営業日の判定に利用しています。
* 以前に投稿した、[日時操作用の自作関数](https://qiita.com/nkojima/items/92c12c416fb6dea3e804)の知見を踏まえたコードとなっています。
 * 本当はループを使わずにスマートに書ければ良かったのですが、中々良い方法を思いつきませんでした...

```vb:DateChecker.bas
Option Explicit

'--------------------------------------------------------------------------------
' 「日本の祝日一覧」のクラス。
'--------------------------------------------------------------------------------
' 祝日一覧（キーが日付文字列、値がJpHoliday型）
Public holidaysDic As Dictionary

'--------------------------------------------------------------------------------
' コンストラクタ
'--------------------------------------------------------------------------------
Public Sub Class_Initialize()
    Set Me.holidaysDic = New Dictionary
    Call GetJpHolidays
End Sub

'--------------------------------------------------------------------------------
' 内閣府の祝日情報CSVを取得して、祝日リストにセットする。
'--------------------------------------------------------------------------------
Private Sub GetJpHolidays()

    ' HTTPSで内閣府の祝日情報CSVを取得する。
    Dim httpObj As HttpClient
    Set httpObj = New HttpClient
    Dim responseCsv As String
    responseCsv = httpObj.GetPage("https://www8.cao.go.jp/chosei/shukujitsu/syukujitsu.csv")
    Set httpObj = Nothing
    
    ' 取得したCSVを「日本の祝日」の構造体のCollectionに詰める
    Dim rows As Variant
    rows = Split(responseCsv, vbCrLf)
    
    Dim i As Integer
    For i = LBound(rows) To UBound(rows)
        ' ヘッダ行と空行（最終行）をスキップして読み込む
        If (i <> 0 And rows(i) <> "") Then
            Dim holiday As JpHoliday
            Set holiday = New JpHoliday
            Call holiday.SetByCsvRow(CStr(rows(i)))
            Me.holidaysDic.Add CStr(holiday.DateOfHoliday), holiday
        End If
    Next i
End Sub

'--------------------------------------------------------------------------------
' 引数の日付が営業日（※）であるかを判定する。
' ※土日および祝日以外を営業日と定義。
'
' d：判定対象の日付。
' return：引数の日付が営業日であればTrue、土日もしくは祝日であればFalseを返す。
'--------------------------------------------------------------------------------
Public Function IsBusinessDay(d As Date) As Boolean
    ' 日付から曜日を取得する。
    Dim day As VbDayOfWeek
    day = Weekday(d, vbSunday)
    
    If (day = vbSaturday Or day = vbSunday) Then
        ' 土日であれば営業日ではない。
        IsBusinessDay = False
    Else
        ' 月～金の場合、祝日であるかを調べて営業日を判定する。
        If holidaysDic.Exists(CStr(d)) Then
            IsBusinessDay = False
        Else
            IsBusinessDay = True
        End If
    End If
    
End Function

'--------------------------------------------------------------------------------
' 引数の日付の年月における、最終営業日を求める。
' ※土日および祝日以外を営業日と定義。
'
' d：最終営業日を求める年月の日付。
' return：引数の日付の年月における最終営業日。
'--------------------------------------------------------------------------------
Public Function CalcLastBusinessDay(d As Date) As Date
    ' 日付から月末日を取得する。
    Dim lastDate As Date
    lastDate = DateSerial(year(d), month(d) + 1, 0)
    
    If (IsBusinessDay(lastDate)) Then
        CalcLastBusinessDay = lastDate
    Else
        Do
            lastDate = DateSerial(year(lastDate), month(lastDate), day(lastDate) - 1)
            If (IsBusinessDay(lastDate)) Then
                CalcLastBusinessDay = lastDate
                Exit Do
            End If
        Loop
    End If
End Function

```

## JpHolidayクラス

* 祝日情報を入れる「箱」に相当するクラスモジュールです。
* クラスモジュールではなく、ユーザー定義型で代用することも可能ですが、以下の理由でクラスモジュールを使っています。
 * ダウンロードしたCSVは、読み込み終わるまで祝日が幾つ存在するかが分かりません。
 * 配列の要素数を幾つ用意すればよいかが分からないのでCollectionを使おうとすると、Collectionの要素としてユーザー定義型を指定できずエラーとなってしまいます。
     * Collectionの代わりに`Redim Preserve...`で動的配列を使えば、ユーザー定義型を使うことが可能です。
     * エラーとなってしまう理由は、[こちらの記事](https://qiita.com/nkojima/items/dad1a4b34ddeff2da59a)に書かれているDictionaryの事例と同じです。


```vb:JpHoliday.bas
Option Explicit
'--------------------------------------------------------------------------------
' 「日本の祝日」のクラス。
'--------------------------------------------------------------------------------
' 祝日の日付
Public DateOfHoliday As Date

' 祝日名
Public Name As String

'--------------------------------------------------------------------------------
' 「内閣府の祝日情報CSV」の1行分のデータから、日付と名称を取得してセットする。
'
' row：「内閣府の祝日情報CSV」の1行分のデータ。{祝日の日付,祝日名}の形式。
'--------------------------------------------------------------------------------
Sub SetByCsvRow(row As String)
    Dim buffs As Variant
    buffs = Split(row, ",")

    Me.DateOfHoliday = CDate(buffs(0))
    Me.Name = buffs(1)
End Sub
```

## HttpClientクラス

* 名前の通り、HTTP（HTTPS通信）をするためのクラスモジュールです。
* 以前に投稿した[【ExcelVBA】HTTP/HTTPS通信でWebページを取得する](https://qiita.com/nkojima/items/c11f6369f4c32b06c90b)に記載されているHttpClientクラスと同じコードです。

```vb:HttpClient.bas
Option Explicit
'--------------------------------------------------------------------------------
' HTTP通信用クラス。
'--------------------------------------------------------------------------------
' HTTP通信用オブジェクト
Private httpObj As Object

'--------------------------------------------------------------------------------
' コンストラクタ
'--------------------------------------------------------------------------------
Public Sub Class_Initialize()
    Set httpObj = CreateObject("MSXML2.ServerXMLHTTP")  ' TLS1.2に対応
End Sub

'--------------------------------------------------------------------------------
' デストラクタ
'--------------------------------------------------------------------------------
Public Sub Class_Terminate()
    Set httpObj = Nothing
End Sub

'--------------------------------------------------------------------------------
' 引数のURLをGETメソッドで取得する。
'
' url：URL文字列。
' return：取得したページ。
'--------------------------------------------------------------------------------
Public Function GetPage(url As String) As String
    httpObj.Open "GET", url
    httpObj.Send

    ' readyState=4で読み込みが完了
    Do While httpObj.readyState < 4
        DoEvents
    Loop

    ' レスポンスヘッダのContent-Typeに適切な文字コードが含まれていない場合、バイト配列から文字コードを指定して文字列を生成する。
    GetPage = StrConv(httpObj.responseBody, vbUnicode)
End Function
```


# テストコード

## IsBusinessDay関数のテスト

```vb:Module1.bas
Sub Test_IsBusinessDay()
    Dim checker As DateChecker
    Set checker = New DateChecker
    
    Debug.Print "2018/10/22は営業日？:" & checker.IsBusinessDay(CDate("2018/10/22"))
    Debug.Print "2018/12/23は営業日？:" & checker.IsBusinessDay(CDate("2018/12/23"))
    Debug.Print "2019/10/22は営業日？:" & checker.IsBusinessDay(CDate("2019/10/22"))
    Debug.Print "2019/12/23は営業日？:" & checker.IsBusinessDay(CDate("2019/12/23"))
End Sub
```

```text:出力結果
2018/10/22は営業日？:True
2018/12/23は営業日？:False
2019/10/22は営業日？:False
2019/12/23は営業日？:True
```

## CalcLastBusinessDay関数のテスト

```vb:Module1.bas
Sub Test_CalcLastBusinessDay()
    Dim checker As DateChecker
    Set checker = New DateChecker
    
    Debug.Print "2019/04/03の月の最終営業日:" & checker.CalcLastBusinessDay(CDate("2019/4/3"))
End Sub
```

```text:出力結果
2019/04/03の月の最終営業日:2019/04/26
```

# まとめ

* VBAでもHTTP通信が出来ることを知っていたので、どうにか営業日を判定するコードを作り上げることができました。
 * プログラムの効率性を考えたら、一度DLしたCSVファイルはExcelのシートに保管（書き込み）しておいた方が良いと思います。
* [こちらの記事](https://qiita.com/nkojima/items/68082034da708c856067)のようにLambda＋API GatewayなどでAPI化してしまえば、社内の各種システム/ツールで幅広く再利用できると思います。