VBAによる祝日判定および祝日取得（改正東京五輪・パラリンピック特別措置法 対応）

2018年6月13日、参院本会議で可決、成立しました。

これに伴って、2020年の祝日が移動するものが出てきたようなので、先日公開した祝日判定処理を更新しました。
また、2020年からは「体育の日」が「スポーツの日」になるそうなので、合わせて対応済みです。

まぁ、祝日の定義の部分を変えただけなんですけどね。
処理内容は全く変えないで、元になる祝日データだけいじればいいので、祝日の追加、廃止、変更等のメンテナンスは楽ですよ。

ソース

▶クリックでソースを展開

Option Explicit

'//////////////////////////////////////////////////
'                   概　　要
'//////////////////////////////////////////////////
'
'用　　　途：祝日取得、確認用
'処理対象日：1948/7/20以降（2050年までは、春分の日、秋分の日確認済み）
'備　　　考：2020/2/23天皇誕生日対応済み
'作　　　成：2018/5/13
'改　　　定：2018/6/14　改正東京五輪・パラリンピック特別措置法（2018/6/13参議院本会議可決分）対応

'//////////////////////////////////////////////////
'                   参照設定
'//////////////////////////////////////////////////

'Dictionary用
'Microsoft Scripting Runtime


'//////////////////////////////////////////////////
'                ユーザー定義型
'//////////////////////////////////////////////////

'月日固定の祝日情報
Private Type FixMD
    sMD         As String
    lBeginYear  As Long
    lEndYear    As Long
    sName       As String
End Type

'月週曜日固定の祝日情報
Private Type FixWN
    lMonth      As Long
    lNthWeek    As Long
    lDayOfWeek  As Long
    lBeginYear  As Long
    lEndYear    As Long
    sName       As String
End Type

'//////////////////////////////////////////////////
'                   定数
'//////////////////////////////////////////////////

'「国民の祝日に関する法律」施行年月日
Private Const BEGIN_DATE    As Date = #7/20/1948#

'「振替休日」施行年月日
Private Const TRANSFER_HOLIDAY1_BEGIN_DATE    As Date = #4/12/1973#
Private Const TRANSFER_HOLIDAY2_BEGIN_DATE    As Date = #1/1/2007#

'「国民の休日」施行年月日
Private Const NATIONAL_HOLIDAY_BEGIN_DATE       As Date = #12/27/1985#

'年上限
Private Const YEAR_MAX      As Long = 2050

'エラーコード（パラメータ異常）
Private Const ERROR_INVALID_PARAMETER   As Long = &H57


'//////////////////////////////////////////////////
'               Private変数
'//////////////////////////////////////////////////

'国民の祝日格納用ディクショナリ
'キー：年月日（DateTime型）
'値　：祝日名
Private dicHoliday_ As New Dictionary

Private lInitializedLastYear_   As Long


'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'
'                       祝日情報の定義
'
'　基本的な祝日情報は、以下の２つのメソッド内で定義する。
'　　getNationalHolidayInfoMD
'　　getNationalHolidayInfoWN
'
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

'//////////////////////////////////////////////////
'月日固定の祝日情報生成
'//////////////////////////////////////////////////
Private Sub getNationalHolidayInfoMD(ByRef uFixMD() As FixMD)

    Dim sFixMD(24)  As String   '祝日データを追加削除した場合、この配列要素数を変更すること
    Dim sResult()   As String
    Dim i           As Long

    '//////////////////////////////////////////////////
    '               月日固定の祝日
    '//////////////////////////////////////////////////
    '適用開始年について
    '　元旦（1/1）
    '　成人の日（1/15）
    '　天皇誕生日（4/29）
    '　憲法記念日（5/3）
    '　こどもの日（5/5）
    'の５つは、「国民の祝日に関する法律」施行年（1948年）に制定されているが
    '同法の施行が7/20であり、それ以前となるため、適用開始年を翌年（1949年）に補正してある。
    '
    '月日,適用開始年,適用終了年,名前
    '適用終了年；9999は、現在も適用中
    sFixMD(0) = "01/01,1949,9999,元日"          '適用開始年補正済み
    sFixMD(1) = "01/15,1949,1999,成人の日"      '適用開始年補正済み
    sFixMD(2) = "02/11,1967,9999,建国記念の日"
    sFixMD(3) = "02/23,2020,9999,天皇誕生日"    '適用開始年補正済み
    sFixMD(4) = "02/24,1989,1989,昭和天皇の大喪の礼"
    sFixMD(5) = "04/10,1959,1959,皇太子明仁親王の結婚の儀"
    sFixMD(6) = "04/29,1949,1988,天皇誕生日"    '適用開始年補正済み
    sFixMD(7) = "04/29,1989,2006,みどりの日"
    sFixMD(8) = "04/29,2007,9999,昭和の日"
    sFixMD(9) = "05/03,1949,9999,憲法記念日"    '適用開始年補正済み
    sFixMD(10) = "05/04,2007,9999,みどりの日"
    sFixMD(11) = "05/05,1949,9999,こどもの日"    '適用開始年補正済み
    sFixMD(12) = "06/09,1993,1993,皇太子徳仁親王の結婚の儀"
    sFixMD(13) = "07/20,1996,2002,海の日"
    sFixMD(14) = "07/23,2020,2020,海の日"
    sFixMD(15) = "07/24,2020,2020,スポーツの日"
    sFixMD(16) = "08/10,2020,2020,山の日"
    sFixMD(17) = "08/11,2016,2019,山の日"
    sFixMD(18) = "08/11,2021,9999,山の日"
    sFixMD(19) = "09/15,1966,2002,敬老の日"
    sFixMD(20) = "10/10,1966,1999,体育の日"
    sFixMD(21) = "11/03,1948,9999,文化の日"
    sFixMD(22) = "11/12,1990,1990,即位礼正殿の儀"
    sFixMD(23) = "11/23,1948,9999,勤労感謝の日"
    sFixMD(24) = "12/23,1989,2018,天皇誕生日"

    ReDim uFixMD(UBound(sFixMD))

    For i = 0 To UBound(sFixMD)
        sResult = Split(sFixMD(i), ",")

        uFixMD(i).sMD = sResult(0)
        uFixMD(i).lBeginYear = CLng(sResult(1))
        uFixMD(i).lEndYear = CLng(sResult(2))
        uFixMD(i).sName = sResult(3)
    Next i

End Sub

'//////////////////////////////////////////////////
'月週曜日固定の祝日情報生成
'//////////////////////////////////////////////////
Private Sub getNationalHolidayInfoWN(ByRef uFixWN() As FixWN)

    Dim sFixWN(5)   As String   '祝日データを追加削除した場合、この配列要素数を変更すること
    Dim sResult()   As String
    Dim i           As Long

    '//////////////////////////////////////////////////
    '               月週曜日固定の祝日
    '//////////////////////////////////////////////////
    '月,週,曜日,適用開始年,適用終了年,名前
    '曜日：日 1
    '　　　月 2
    '　　　火 3
    '　　　水 4
    '　　　木 5
    '　　　金 6
    '　　　土 7
    '適用終了年；9999は、現在も適用中
    sFixWN(0) = "01,2,2,2000,9999,成人の日"
    sFixWN(1) = "07,3,2,2003,2019,海の日"
    sFixWN(2) = "07,3,2,2021,9999,海の日"
    sFixWN(3) = "09,3,2,2003,9999,敬老の日"
    sFixWN(4) = "10,2,2,2000,2019,体育の日"
    sFixWN(5) = "10,2,2,2021,9999,スポーツの日"

    ReDim uFixWN(UBound(sFixWN))

    For i = 0 To UBound(sFixWN)
        sResult = Split(sFixWN(i), ",")

        uFixWN(i).lMonth = CLng(sResult(0))
        uFixWN(i).lNthWeek = CLng(sResult(1))
        uFixWN(i).lDayOfWeek = CLng(sResult(2))
        uFixWN(i).lBeginYear = CLng(sResult(3))
        uFixWN(i).lEndYear = CLng(sResult(4))
        uFixWN(i).sName = sResult(5)
    Next i
End Sub
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'                       祝日情報の定義　ここまで
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

Private Sub Class_Initialize()

    Set dicHoliday_ = New Dictionary

    lInitializedLastYear_ = &H80000000

    'デフォルトで、現在の５年後までデータを生成する
    InitializedLastYear = Year(Now) + 5

End Sub

Private Sub Class_Terminate()

    Set dicHoliday_ = Nothing

End Sub


'//////////////////////////////////////////////////
'指定日が国民の祝日（休日）か？
'//////////////////////////////////////////////////
Public Function isNationalHoliday(ByVal dtDate As Date) As Boolean

    Dim dtDateW As Date

    '時分秒データを切り捨てる
    dtDateW = DateSerial(Year(dtDate), Month(dtDate), Day(dtDate))

    If dtDateW < BEGIN_DATE Then
        Err.Raise ERROR_INVALID_PARAMETER, "isNationalHoliday", Format$(dtDateW, "yyyy/mm/dd") & "は、適用範囲外です。"

        Exit Function
    ElseIf Year(dtDateW) > YEAR_MAX Then
        Err.Raise ERROR_INVALID_PARAMETER, "isNationalHoliday", Format$(YEAR_MAX + 1, "yyyy年") & "以降は、適用範囲外です。"

        Exit Function
    ElseIf Year(dtDateW) > InitializedLastYear Then
        Err.Raise ERROR_INVALID_PARAMETER, "isNationalHoliday", Format$(dtDateW, "yyyy年") & "は、データが生成されていないため、判定できません。" _
                            & vbCrLf & "reInitializeメソッドで対象年を設定後、再度確認してみて下さい。"

        Exit Function
    End If

    isNationalHoliday = dicHoliday_.Exists(dtDateW)

End Function

'//////////////////////////////////////////////////
'指定日が国民の祝日（休日）か？そうであれば、その祝日名を合わせて返す
'//////////////////////////////////////////////////
Public Function isNationalHoliday2(ByVal dtDate As Date, ByRef sHolidayName As String) As Boolean

    Dim dtDateW As Date

    '時分秒データを切り捨てる
    dtDateW = DateSerial(Year(dtDate), Month(dtDate), Day(dtDate))

    isNationalHoliday2 = isNationalHoliday(dtDateW)

    sHolidayName = getNationalHolidayName(dtDateW)

End Function

'//////////////////////////////////////////////////
'指定年の祝日を配列に格納して返す
'//////////////////////////////////////////////////
Public Function getNationalHolidays(ByVal lYear As Long, ByRef dtHolidays() As Date) As Long

    Dim dtHolidaysW()   As Date
    Dim lHolidays       As Long
    Dim i As Long

    lHolidays = 0
    ReDim dtHolidaysW(lHolidays)

    For i = 0 To dicHoliday_.Count - 1
        If Year(dicHoliday_.Keys(i)) = lYear Then
            ReDim Preserve dtHolidaysW(lHolidays)

            dtHolidaysW(lHolidays) = dicHoliday_.Keys(i)

            lHolidays = lHolidays + 1
        End If
    Next i

    '昇順並べ替え
    Call qSort(dtHolidaysW, 0, UBound(dtHolidaysW))

    Erase dtHolidays
    dtHolidays = dtHolidaysW

    getNationalHolidays = lHolidays

End Function

'//////////////////////////////////////////////////
'指定日の祝日名を返す
'//////////////////////////////////////////////////
Public Function getNationalHolidayName(ByVal dtHoliday As Date) As String

    Dim dtDateW As Date

    '時分秒データを切り捨てる
    dtDateW = DateSerial(Year(dtHoliday), Month(dtHoliday), Day(dtHoliday))

    If isNationalHoliday(dtDateW) = True Then
        getNationalHolidayName = dicHoliday_.Item(dtDateW)
    End If

End Function

'//////////////////////////////////////////////////
'何年までの祝日データが生成されているか
'//////////////////////////////////////////////////
Public Property Get InitializedLastYear() As Long

    InitializedLastYear = lInitializedLastYear_

End Property

'//////////////////////////////////////////////////
'指定年までの祝日データを生成させる（YEAR_MAX以下）
'　外部からの要求は、reInitializeで行うことが出来る
'//////////////////////////////////////////////////
Private Property Let InitializedLastYear(ByVal lInitializedLastYear As Long)

    If lInitializedLastYear < lInitializedLastYear_ Then
        '要求された最終年が初期化済みの年より前ならば、処理しない
        Exit Property
    ElseIf lInitializedLastYear > YEAR_MAX Then
        lInitializedLastYear = YEAR_MAX
    End If

    Call initDictionary(lInitializedLastYear)

    lInitializedLastYear_ = lInitializedLastYear

End Property

'//////////////////////////////////////////////////
'指定年までの祝日データを生成させる
'//////////////////////////////////////////////////
Public Sub reInitialize(ByVal lLastYear As Long)

    InitializedLastYear = lLastYear

End Sub

'//////////////////////////////////////////////////
'Dictionaryへ祝日情報を格納
'//////////////////////////////////////////////////
Private Sub initDictionary(ByVal lLastYear As Long)

    Dim uFixMD()    As FixMD
    Dim uFixWN()    As FixWN

    '月日固定の祝日情報
    Call getNationalHolidayInfoMD(uFixMD)

    '月週曜日固定の祝日情報
    Call getNationalHolidayInfoWN(uFixWN)

    'Dictionaryへ追加
    Call add2Dictionary(lLastYear, uFixMD, uFixWN)

End Sub

'//////////////////////////////////////////////////
'祝日情報をDictionaryへ格納
'//////////////////////////////////////////////////
Private Sub add2Dictionary(ByVal lLastYear As Long, ByRef uFixMD() As FixMD, ByRef uFixWN() As FixWN)

    Dim lInitializedLastYear    As Long
    Dim lBeginYear          As Long
    Dim lEndYear            As Long
    Dim dtHoliday           As Date
    Dim lAddedDays          As Long
    Dim dtAdded()           As Date
    Dim existsHoliday       As Boolean
    Dim lYear               As Long
    Dim i                   As Long

    '初期化済みの最終年を取得
    lInitializedLastYear = InitializedLastYear

    If lInitializedLastYear < Year(BEGIN_DATE) Then
        '施工年より前ならば、施工年を開始年とする
        lBeginYear = Year(BEGIN_DATE)
    Else
        '施工年以後なら、初期化済みの翌年を開始年とする
        lBeginYear = lInitializedLastYear + 1
    End If

    lEndYear = lLastYear

    For lYear = lBeginYear To lEndYear
        '年間の祝日格納用配列クリア
        lAddedDays = 0
        ReDim dtAdded(lAddedDays)

        '月日固定の祝日
        For i = 0 To UBound(uFixMD)
            '適用期間のみを対象とする
            If uFixMD(i).lBeginYear <= lYear And uFixMD(i).lEndYear >= lYear Then
                dtHoliday = CDate(CStr(lYear) & "/" & uFixMD(i).sMD)

                dicHoliday_.Add dtHoliday, uFixMD(i).sName

                ReDim Preserve dtAdded(lAddedDays)
                dtAdded(lAddedDays) = dtHoliday
                lAddedDays = lAddedDays + 1
            End If
        Next i

        '月週曜日固定の祝日
        For i = 0 To UBound(uFixWN)
            '適用期間のみを対象とする
            If uFixWN(i).lBeginYear <= lYear And uFixWN(i).lEndYear >= lYear Then
                dtHoliday = getNthWeeksDayOfWeek(lYear, uFixWN(i).lMonth, uFixWN(i).lNthWeek, uFixWN(i).lDayOfWeek)

                dicHoliday_.Add dtHoliday, uFixWN(i).sName

                ReDim Preserve dtAdded(lAddedDays)
                dtAdded(lAddedDays) = dtHoliday
                lAddedDays = lAddedDays + 1
            End If
        Next i

        '春分の日
        dtHoliday = getVernalEquinoxDay(lYear)
        dicHoliday_.Add dtHoliday, "春分の日"

        ReDim Preserve dtAdded(lAddedDays)
        dtAdded(lAddedDays) = dtHoliday
        lAddedDays = lAddedDays + 1

        '秋分の日
        dtHoliday = getAutumnalEquinoxDay(lYear)
        dicHoliday_.Add dtHoliday, "秋分の日"

        ReDim Preserve dtAdded(lAddedDays)
        dtAdded(lAddedDays) = dtHoliday
        lAddedDays = lAddedDays + 1

        '振替休日
        For i = 0 To lAddedDays - 1
            existsHoliday = existsSubstituteHoliday(dtAdded(i), dtHoliday)

            If existsHoliday = True Then
                dicHoliday_.Add dtHoliday, "振替休日"
            End If
        Next i

        '国民の休日
        For i = 0 To lAddedDays - 1
            existsHoliday = existsNationalHoliday(dtAdded(i), dtHoliday)

            If existsHoliday = True Then
                dicHoliday_.Add dtHoliday, "国民の休日"
            End If
        Next i

        Erase dtAdded
    Next lYear

End Sub

'//////////////////////////////////////////////////
'振替休日の有無
'　祝日（dtDate）に対する振替休日の有無（ある場合は、dtSubstituteHolidayに代入される）
'//////////////////////////////////////////////////
Private Function existsSubstituteHoliday(ByVal dtDate As Date, ByRef dtSubstituteHoliday As Date) As Boolean

    Dim dtNextDay   As Date

    existsSubstituteHoliday = False

    If dicHoliday_.Exists(dtDate) = False Then
        'dtDateが祝日でなければ終了
        Exit Function
    End If

    '適用期間のみを対象とする
    If dtDate >= TRANSFER_HOLIDAY1_BEGIN_DATE And dtDate < TRANSFER_HOLIDAY2_BEGIN_DATE Then
        If Weekday(dtDate) = vbSunday Then
            '祝日が日曜日であれば、翌日（月曜日）が振替休日
            dtSubstituteHoliday = DateAdd("d", 1, dtDate)

            existsSubstituteHoliday = True
        End If
    ElseIf dtDate >= TRANSFER_HOLIDAY2_BEGIN_DATE Then
        '「国民の祝日」が日曜日に当たるときは、その日後においてその日に最も近い「国民の祝日」でない日を休日とする
        If Weekday(dtDate) = vbSunday Then
            dtNextDay = DateAdd("d", 1, dtDate)

            '直近の祝日でない日を取得
            Do Until dicHoliday_.Exists(dtNextDay) = False
                dtNextDay = DateAdd("d", 1, dtNextDay)
            Loop

            dtSubstituteHoliday = dtNextDay

            existsSubstituteHoliday = True
        End If
    End If

End Function

'//////////////////////////////////////////////////
'国民の休日の有無
'　祝日（dtDate）に対す国民の休日の有無（ある場合は、dtNationalHolidayに代入される）
'//////////////////////////////////////////////////
Private Function existsNationalHoliday(ByVal dtDate As Date, ByRef dtNationalHoliday As Date) As Boolean

    Dim dtBaseDay   As Date
    Dim dtNextDay   As Date

    existsNationalHoliday = False

    If dicHoliday_.Exists(dtDate) = False Then
        'dtDateが祝日でなければ終了
        Exit Function
    End If

    '適用期間のみを対象とする
    If dtDate >= NATIONAL_HOLIDAY_BEGIN_DATE Then
        dtBaseDay = DateAdd("d", 1, dtDate)

        '直近の祝日でない日を取得
        Do Until dicHoliday_.Exists(dtBaseDay) = False
            dtBaseDay = DateAdd("d", 1, dtBaseDay)
        Loop

        '日曜日であれば対象外
        If Weekday(dtBaseDay) <> vbSunday Then
            dtNextDay = DateAdd("d", 1, dtBaseDay)

            '翌日が祝日であれば対象
            If dicHoliday_.Exists(dtNextDay) = True Then
                existsNationalHoliday = True

                dtNationalHoliday = dtBaseDay
            End If
        End If
    End If

End Function

'//////////////////////////////////////////////////
'月の第N W曜日の日付を取得
'//////////////////////////////////////////////////
Private Function getNthWeeksDayOfWeek(ByVal lYear As Long, _
                                      ByVal lMonth As Long, _
                                      ByVal lNth As Long, _
                                      ByVal lDayOfWeek As VbDayOfWeek) As Date

    Dim dt1stDate       As Date
    Dim lDayOfWeek1st   As Long
    Dim lOffset         As Long

    '指定年月の１日を取得
    dt1stDate = DateSerial(lYear, lMonth, 1)

    '１日の曜日を取得
    lDayOfWeek1st = Weekday(dt1stDate)

    '指定日へのオフセットを取得
    lOffset = lDayOfWeek - lDayOfWeek1st

    If lDayOfWeek1st > lDayOfWeek Then
        lOffset = lOffset + 7
    End If

    lOffset = lOffset + 7 * (lNth - 1)

    getNthWeeksDayOfWeek = DateAdd("d", lOffset, dt1stDate)

End Function

'//////////////////////////////////////////////////
'春分の日を取得
'//////////////////////////////////////////////////
Private Function getVernalEquinoxDay(ByVal lYear As Long) As Date

    Dim lDay    As Long

    lDay = Int(20.8431 + 0.242194 * (lYear - 1980) - Int((lYear - 1980) / 4))

    getVernalEquinoxDay = DateSerial(lYear, 3, lDay)

End Function

'//////////////////////////////////////////////////
'秋分の日を取得
'//////////////////////////////////////////////////
Private Function getAutumnalEquinoxDay(ByVal lYear As Long) As Date

    Dim lDay    As Long

    lDay = Int(23.2488 + 0.242194 * (lYear - 1980) - Int((lYear - 1980) / 4))

    getAutumnalEquinoxDay = DateSerial(lYear, 9, lDay)

End Function

Private Sub qSort(ByRef dtHolidays() As Date, ByVal lLeft As Long, ByVal lRight As Long)

    Dim dtCenter    As Date
    Dim dtTemp      As Date
    Dim i           As Long
    Dim j           As Long

    If lLeft < lRight Then
        dtCenter = dtHolidays((lLeft + lRight) \ 2)

        i = lLeft - 1
        j = lRight + 1

        Do While (True)
            i = i + 1
            Do While (dtHolidays(i) < dtCenter)
                i = i + 1
            Loop

            j = j - 1
            Do While (dtHolidays(j) > dtCenter)
                j = j - 1
            Loop

            If i >= j Then
                Exit Do
            End If

            dtTemp = dtHolidays(i)
            dtHolidays(i) = dtHolidays(j)
            dtHolidays(j) = dtTemp
        Loop

        Call qSort(dtHolidays, lLeft, i - 1)
        Call qSort(dtHolidays, j + 1, lRight)
    End If

End Sub

実行例

2019年から2021年の７月から１０月の祝日を出力した結果が以下の通り。

----- 2019 -----
2019/07/15 海の日
2019/08/11 山の日
2019/08/12 振替休日
2019/09/16 敬老の日
2019/09/23 秋分の日
2019/10/14 体育の日

----- 2020 -----
2020/07/23 海の日
2020/07/24 スポーツの日
2020/08/10 山の日
2020/09/21 敬老の日
2020/09/22 秋分の日

----- 2021 -----
2021/07/19 海の日
2021/08/11 山の日
2021/09/20 敬老の日
2021/09/23 秋分の日
2021/10/11 スポーツの日

【VBA / Excel】祝日休日の判定、取得用データを生成し、実際に判定、取得してみる

この記事では、予め用意された祝日テーブルを使用するのではなく、
クラスモジュール内で、祝日テーブルを自前で生成し、Dictionary に格納して判定処理を行っています。
祝日の定義は、クラスモジュール内に、汎用性を考慮した状態でハードコーディングしてあります。
このため、法の変更等により、祝日が変わらなければ、このまま使用できます。
別途、祝日テーブルを用意する必要はありません。

2018/9/10 追記
この記事は、祝日（振替休日等を含む）を判定の対象にしていますが、日曜日や年末年始の休み等は判定対象外です。
これらの休日も判定対象に含めたい場合には、以下の記事をあわせて参照してみて下さい。
z1000s.hatenablog.com

2018/6/14 追記
この記事には、2018/6/13の改正東京五輪・パラリンピック特別措置法が参院本会議での可決に伴って、更新された記事があります。
z1000s.hatenablog.com

2019/5/23 追記
Googleで検索して来る方が多いようですが、中にはこのページが本来の目的ではない方もいるかもしれないので、とりあえず、「こんなページもあるよ」ということで載せておきます。
z1000s.hatenablog.com
z1000s.hatenablog.com

目次みたいなもの

「Excelで祝日判定をしたい」というと、「祝日データを用意して、それを・・・」とお決まりの文言が出てくるのが一般的です。
では、その祝日データはどうすれば用意できるのでしょうか？

ここのように、期間を指定して生成してくれるようなところもあるようです。

が、必要なデータが変わるたびにサイトにアクセスしてというのも面倒です。
となれば、「自分で作ってしまえ作れるようにしてしまえ」となりました。

以上

？？？普通ならそうはならない？？？
まぁ、いいじゃないですか。私がそう思ったんだから。
それに、ここで終わったら、ただの落書きで終わってしましますよ。

そろそろ本題に。

まず、処理するに当たって祝日を分類してみる。カッコ内は例。

1. 月、日が固定のもの（元日：１月１日）
2. 月、第N ○曜日が固定のもの（成人の日：１月第２月曜日）
3. 月は固定だが、日が可変のもの（春分の日：３月１９〜２２日）
4. 月、日が定まっておらず、他の祝日などに依存するもの（振替休日、国民の休日）

１、２項は簡単に求められる。
３項は、計算式があるのでこれも問題なし。
４項は、他の祝日に依存するため、単独では求められない。予め１〜３項の祝日がわかっている必要がある。（或いは、その都度依存する日の状態を確認するか。）

では具体的にどうすれば求められるか、簡単（？）かもしれない解説。
前提条件として、データはDate型で保持するものとします。

１．月、日が固定のもの

VBA では、DateSerial 関数を使用すると、年、月、日を指定してDate 型の値を取得できます。

DateSerial( year, month, day )

DateSerial 関数については、こちら

２．月、第N ○曜日が固定のもの

指定された月の１日の曜日がわかれば、１日以降の最初の指定された曜日（第１○曜日）へのオフセット値（何日補正すればよいか）がわかります。
それがわかれば、７の倍数を加算することで求められます。

まず、指定月の１日を求めるのは、１項で登場したDateSerial 関数。

DateSerial( year, month, 1 )

と日に「1」を指定すればOK。

次にその曜日
曜日は、Weekday 関数を使用します。

Weekday( date , [ firstdayofweek ] )

dateに、上で求めた１日の日付データを渡します。
firstdayofweekは省略可能です。今回は使用しません。
そうすると、指定した日付によって１〜７の値が返ってきます。

定数	値	説明
vbSunday	1	日曜日
vbMonday	2	月曜日
vbTuesday	3	火曜日
vbWednesday	4	水曜日
vbThursday	5	木曜日
vbFriday	6	金曜日
vbSaturday	7	土曜日

これを書いている２０１８年５月の場合を考えてみます。
第２週までのカレンダーは、以下の通りです。

日	月	火	水	木	金	土
		1	2	3	4	5
6	7	8	9	10	11	12

最初の曜日までの日数は、以下のようになります。

曜日	指定曜日の日付	１日から指定曜日までの日数
日曜日	6	5
月曜日	7	6
火曜日	1	0
水曜日	2	1
木曜日	3	2
金曜日	4	3
土曜日	5	4

で、曜日を使って「指定曜日までの日数」をどうやって求めるかというと
前述の曜日の定数を使って「指定曜日」 から 「１日の曜日」を引きます。
ただし、「指定曜日」が「１日の曜日」より前の場合、結果が負の値となるのでその場合には７を加えます。

５月１日は火曜日なので、vbTuesday ===> 3
例えば、第１金曜日なら、vbFriday ===> 6
なので、6 - 3 = 3 となります。

第１日曜日なら、vbSunday ===> 1
なので、1 - 3 = -2 となりますが、結果が負なので、+7 して
-2 + 7 = 5 となります。

この値が求められれば、次は１日の日付に加算を行います。
日付の加減算は、DateAdd 関数を使用します。

DateAdd(interval, number, date)

intervalには、日数の計算を行うので、"d" を指定します。
numberには、上記の計算で求めた値を指定します。
dateには、１日の日付データを指定します。

最初の曜日であれば、これで良いのですが２回め以降の曜日の場合、更に７の倍数を加算する必要があります。
第２曜日であれば、+7
第３曜日であれば、+14
第４曜日であれば、+21
第５曜日であれば、+28
となるので、第N曜日の場合
（N　ー　１）＊７
を加算すれば良いことになります。

最終的には、以下のようなプロシージャにより求められます。

Public Function getNthWeeksDayOfWeek(ByVal lYear As Long, _
                                      ByVal lMonth As Long, _
                                      ByVal lNth As Long, _
                                      ByVal lDayOfWeek As VbDayOfWeek) As Date

    Dim dt1stDate       As Date
    Dim lDayOfWeek1st   As Long
    Dim lOffset         As Long

    '指定年月の１日を取得
    dt1stDate = DateSerial(lYear, lMonth, 1)

    '１日の曜日を取得
    lDayOfWeek1st = Weekday(dt1stDate)

    '指定日へのオフセットを取得
    lOffset = lDayOfWeek - lDayOfWeek1st

    If lDayOfWeek1st > lDayOfWeek Then
        lOffset = lOffset + 7
    End If

    lOffset = lOffset + 7 * (lNth - 1)

    getNthWeeksDayOfWeek = DateAdd("d", lOffset, dt1stDate)

End Function

ただし、N ＞＝ ５を指定した場合、日付が翌月になる場合がありますので、注意が必要です。

Weekday 関数については、こちら
DateAdd 関数については、こちら

３．月は固定だが、日が可変のもの

これは、春分の日と秋分の日が該当。
Wikipediaによると
春分の日は、３月１９～２２日のいずれか。
秋分の日は、２２～２４日のいずれか。
となっている。
一般に、

'春分の日
Int(20.8431 + 0.242194 * (年 - 1980)) - Int((年 - 1980) / 4)
'秋分の日
Int(23.2488 + 0.242194 * (年 - 1980)) - Int((年 - 1980) / 4)

という計算で求められるようです。
１９８０年以降に限定すれば、以下の内容でもOK。
というか、こうしたかったんだけれど、１９７９年以前の場合、
￥演算子の結果が、Fix 関数と同等になり、Int 関数とは結果が変わってしまうため
If で振り分ける等の必要が生じてしまうので、上記の式をそのまま使用することにしました。

'春分の日
Int(20.8431 + 0.242194 * (年 - 1980)) - (年 - 1980) \ 4
'秋分の日
Int(23.2488 + 0.242194 * (年 - 1980)) - (年 - 1980) \ 4

ちなみに、￥演算子を使用した場合は、内部で整数演算が行われるが、
/演算子の場合、整数同士の演算であっても、内部では浮動小数点数で演算が行われます。

４．月日が定まっておらず、他の祝日などに依存するもの

４．１　振替休日

1973年の国民の祝日に関する法律が改正されたことにより制定された。これにより祝日（国民の祝日）が日曜日の場合、その翌日となる月曜日が振替休日となった（ハッピーマンデー制度の法律と同じ）。1973年の天皇誕生日（4月29日）が日曜日で、同年4月30日が最初の適用日となった。

当初は祝日が2日以上連続することがなかったため、「国民の祝日の日曜日の翌日の月曜日」としていた。しかし2005年の国民の祝日に関する法律の改正（2007年施行）で、4月29日が「昭和の日」となり、「みどりの日」が4月29日から5月4日へ変更。5月3日から5月5日まで祝日が3日連続することになり、その直後の「国民の祝日の日曜日の翌日の月曜日以降の国民の祝日でない祝日の翌日」を休日とすることと改められ振替先が月曜日固定ではなくなった。

振替休日 - Wikipedia

ということなので、
祝日が日曜日であった場合、適用された年から判断し、その翌日または、それ以降で最初の祝日でない日を求めればOK。
２００７年以降では、当然ながらこの日が月曜日とは限りません。
２０１５年５月３日の憲法記念日の振替休日は、６日の水曜日でした。
　５月３日（日）：憲法記念日
　５月４日（月）：みどりの日
　５月５日（火）：こどもの日
　５月６日（水）：５月３日の振替休日

４．２　国民の休日

前後が祝日である平日は、国民の休日となり、休日となる。

国民の休日 - Wikipedia

こちらは、翌々日まで確認が必要なので、要件は振替休日より複雑。

1. 最初の祝日が月曜日から金曜日の間にあること。
   1. 最初の祝日が日曜日の場合、翌日は振替休日となるので、２項を満足しない。
   2. 最初の祝日が土曜日の場合、翌日は日曜日となるので、平日ではない。
2. 最初の祝日の翌日が、平日であること。（祝日でなく、休日でもないこと。）
3. 最初の祝日の翌々日が、祝日であること。

これらの条件を満たした時、最初の祝日の翌日が「国民の休日」となる。

２項、３項の祝日は、年によって日付が変動する祝日であり、「移動祝日」または「移動祝祭日」と呼ぶそうです。

最終的なコード

VBAのクラスとして作成しました。
▶クリックでソースを展開/縮小
2021/4/11
都合により、
VBAによる「祝日判定処理」を「休日判定処理」に拡張してみた - 空腹おやじのログと備忘録
と、コードを統合した上で、
こちら に移動しました。

CCompanyHoliday.clsのみ
https://github.com/Z1000R/determining-and-retrieving-holidays/blob/main/Source/CCompanyHoliday.cls

その他諸々を含めて一式
github.com

パブリックメソッド一覧

isNationalHoliday(ByVal dtDate As Date) As Boolean

指定日が国民の祝日（休日）か？

引　数	IN/OUT	内容
dtDate As Date	IN	判定したい日付

復帰値	内容
True	国民の祝日（休日）である。
False	国民の祝日（休日）ではない。

isNationalHoliday2(ByVal dtDate As Date, ByRef sHolidayName As String) As Boolean

指定日が国民の祝日（休日）か？そうであれば、その祝日名を合わせて返す

引　数	IN/OUT	内容
dtDate As Date	IN	判定したい日付
sHolidayName As String	OUT	祝日名

復帰値	内容
True	国民の祝日（休日）である。
False	国民の祝日（休日）ではない。

getNationalHolidays(ByVal lYear As Long, ByRef dtHolidays() As Date) As Long

指定年の国民の祝日を配列に格納して返す

引　数	IN/OUT	内容
lYear As Long	IN	取得したい年
dtHolidays() As Date	OUT	指定された年の国民の祝日

復帰値
国民の祝日の件数

getNationalHolidayName(ByVal dtHoliday As Date) As String

指定日の国民の祝日名を返す

引　数	IN/OUT	内容
dtHoliday As Date	IN	日付

復帰値
指定された日付の国民の祝日名

指定された日付が国民の祝日でない場合、復帰値は長さ０の文字列となる。

reInitialize(ByVal lLastYear As Long)

指定年までの祝日データが生成されていなければ、追加生成する。

引　数	IN/OUT	内容
lLastYear As Long	IN	生成したい最終年

現在の何年までのデータが生成されているかは、後述のInitializedLastYearプロパティで取得できる。

パブリックプロパティ

InitializedLastYear() As Long

何年までの国民の祝日データが生成されているか
（読み取り専用）

使い方と実行例

クラス名は、CNationalHoliday としています。
使用する前に、Newを付けて、インスタンスを生成して下さい。
（そのタイミングで、デフォルトで現在の年から５年後の年末までの祝日を内部で生成します。）
その後に、必要なメソッドを呼び出します。

日付を指定して、祝日判定をして、祝日名を取得する

Public Sub Test1()

    Dim cnh     As New CNationalHoliday
    Dim dt      As Date
    Dim sHolidayName As String

    dt = #8/11/2015#
    Debug.Print Format$(dt, "yyyy/mm/dd"), cnh.getNationalHolidayName(dt), cnh.isNationalHoliday2(dt, sHolidayName)

    dt = #8/11/2016#
    Debug.Print Format$(dt, "yyyy/mm/dd"), cnh.getNationalHolidayName(dt), cnh.isNationalHoliday2(dt, sHolidayName)

    dt = #8/12/2018#
    Debug.Print Format$(dt, "yyyy/mm/dd"), cnh.getNationalHolidayName(dt), cnh.isNationalHoliday2(dt, sHolidayName)

    dt = #8/12/2019#
    Debug.Print Format$(dt, "yyyy/mm/dd"), cnh.getNationalHolidayName(dt), cnh.isNationalHoliday2(dt, sHolidayName)

    dt = #2/23/2020#
    Debug.Print Format$(dt, "yyyy/mm/dd"), cnh.getNationalHolidayName(dt), cnh.isNationalHoliday2(dt, sHolidayName)

    Set cnh = Nothing

End Sub

実行結果

call Test1
2015/08/11                  False
2016/08/11    山の日        True
2018/08/12                  False
2019/08/12    振替休日      True
2020/02/23    天皇誕生日    True

年を指定して、祝日および祝日名を取得する

Public Sub Test2(ByVal lYear As Long)

    Dim cnh     As New CNationalHoliday
    Dim dt()    As Date
    Dim i As Long

    Call cnh.getNationalHolidays(lYear, dt)

    For i = 0 To UBound(dt)
        Debug.Print dt(i), cnh.getNationalHolidayName(dt(i))
    Next i

    Set cnh = Nothing

End Sub

実行結果

call Test2(2018)
2018/01/01    元日
2018/01/08    成人の日
2018/02/11    建国記念の日
2018/02/12    振替休日
2018/03/21    春分の日
2018/04/29    昭和の日
2018/04/30    振替休日
2018/05/03    憲法記念日
2018/05/04    みどりの日
2018/05/05    こどもの日
2018/07/16    海の日
2018/08/11    山の日
2018/09/17    敬老の日
2018/09/23    秋分の日
2018/09/24    振替休日
2018/10/08    体育の日
2018/11/03    文化の日
2018/11/23    勤労感謝の日
2018/12/23    天皇誕生日
2018/12/24    振替休日

祝日データを、デフォルトの５年後より後の分も生成する

Public Sub Test3()

    Dim cnh As CNationalHoliday
    Dim dt  As Date
    Dim i As Long

    Set cnh = New CNationalHoliday

    Debug.Print "Before reInitialize", cnh.InitializedLastYear

    cnh.reInitialize 2030

    Debug.Print "After reInitialize", cnh.InitializedLastYear

    Set cnh = Nothing

End Sub

実行結果

call Test3
Before reInitialize          2023 
After reInitialize           2030 

お約束

掲載したコードの使用については、特に制限は設けません MITライセンスとします。
ご自由にお使い下さい。
使用にあたって、私への連絡等は不要です。

ただし、使用した結果、何らかのトラブル、損害、その他諸々の事象が発生しても、私は一切関与しません。
使用する方ソースコードを組み込んだ方が責任を取れる範囲内で使って下さい。（2018/9/9 一部修正）

バグ、要望、気が付いた事などあれば、コメントしていただければと思います。

参考にしたサイト

• 基本的な祝日情報はWikipediaから。
  • 国民の祝日 - Wikipedia
  • 振替休日 - Wikipedia
  • 国民の休日 - Wikipedia
  • 国民の祝日に関する法律 - Wikipedia

• 春分の日および秋分の日および、その計算に関する情報はこちらから
  • 春分の日 - Wikipedia
  • 秋分の日 - Wikipedia
  • 祝日について

• 皇室慶弔行事に伴う休日の情報はこちらから
  • 国民の祝日 - Wikipedia

• 検証用データはこちらから
  • AddinBox(Main)

秀丸で、選択行の行頭に文字を挿入するマクロ

先日、人力検索はてなで、
q.hatena.ne.jp
に回答して、ベストアンサーを頂いたのですが
ベースになった物があって、C++のソースを編集する際に、

• 行コメントの追加
• 既存の行を改修してコメント化

するために以前作ったもの（下記）でした。
（今回の件で、ちょっとしたバグを発見して修正したけど・・・）

あちらにアップしたものは、コメント削除したものなので、わかりにくかったかも。

$comment_prefix = "//";

//範囲選択されているか
if ( selecting == 1 )
{
	//範囲選択されていたら解除
	escape;

	//選択開始行
	#TargetLine = seltopy + 1;

	//選択終了行
	if ( selendx == 0 )
	{
		//選択終了行のカーソル位置が行先頭なら、その行はコメント化しない
		#EndLine    = selendy;
	}
	else
	{
		#EndLine    = selendy + 1;
	}

	//選択開始行に移動
	movetolineno 1, seltopy + 1;
}
else
{
	//選択開始行
	#TargetLine = lineno;

	//選択終了行
	#EndLine    = lineno;
}

//最終行に移動
gofileend;

//最終行取得
#FileEndLine = lineno;

//元の行に戻る
movetolineno 1, #TargetLine;

while ( #TargetLine != #EndLine + 1 )
{
	//行先頭に移動
	golinetop;

	//コメント化
	insert $comment_prefix;

	//処理行をインクリメント
	#TargetLine = #TargetLine + 1;

	if ( #TargetLine > #FileEndLine )
	{
		break;
	}

	//１行下へ移動
	movetolineno 1, #TargetLine;
}

LINEのバックアップがGoogleドライブに見当たらない？

スマホの機種変更をしようとしていた知人から、
「LINEのバックアップをGoogleドライブに保存したけど、ファイルが見当たらない。このまま移行作業を進めてもいいのか？」
と相談されました。
LINEの設定画面には、バックアップ日時が表示されているし、
再度バックアップすると、日時が更新されるので、
バックアップデータは、アップロードされているような雰囲気。

自分のスマホでバックアップして、Googleドライブを覗いてみても確かに見当たらない。
隠しファイルを表示させても見えない。
試しにPCのブラウザから、ドライブを確認してみても見当たらない。

で、探したら見つけました。
PCのブラウザで、Googleドライブを表示させ、「設定」-「アプリの管理」を表示させると、「非表示のアプリデータ」として保存されていました。

見えないと、本当に保存されているのか不安ですよね。
とりあえず解決ということで・・・

MS AccessのインストールされていないPCで、VBA（Excel）を使って accdbを最適化する

最近VBAネタが続く・・・

今使っているOffice 2013を買う時、Accessはあれば便利かもしれないけど、
「どうせ使う機会は無いだろう」という事で、Office Personalを買ったので
Accessは持っていない。

しかし、最近になって〇〇なデータ管理をしようかと思ったが、どうにもExcelだけでは厳しい。
ローカルで手軽に使えるデータベースが欲しいけれど、このためだけにAccessを買うというのももったいない。
（LibreOffice Calc Baseという選択肢はない。）
バックエンド用として使えれば、フロントエンドはC#とか最悪Excelでもなんとか出来る。

あれ、mdbってVBAで作れなかった？
やっぱり作れるじゃないか、accdbも！

で、このゴールデンウィークに、accdbファイル自体と、
それに、テーブルを作るためのツールを作った。
肝心のデータ管理用のフロントエンドは全く出来ていないし
データもインサートしてないのに、気が早くて「最適化ツールは絶対必要だ！！！」
となり、作り始めたはいいが、コンパイルエラー
"DBEngine"を、「変数が定義されていません」とおっしゃる。

DAOの参照設定してないじゃん。
Microsoft DAO 3.6 Object Library 参照設定して、コンパイルもOK。
いざ、実行！

実行時エラー 3343
データベースの形式 'C:\Datas\sample.accdb' を認識できません。

調べていくと

引数 options に次のいずれかの定数を使用すると、最適化されたデータベースのデータの形式のバージョンを指定できます。
・・・
dbVersion120
最適化に Microsoft Access データベース エンジン バージョン 12.0 のファイル形式を使用するデータベースを作成します。

DBEngine.CompactDatabase method (DAO) | Microsoft Docs

オプションに、dbVersion120を追記して、コンパイルしてみる。
"dbVersion120"に対して、"変数が定義されていません。"

まだ、だめですか・・・orz

さらに調べていくと、

DAO 12.0 (ACEDAO.DLL) の DBEngine.CompactDatabase メソッドを利用する。

VBレスキュー(花ちゃん) の Visual Basic 2010 用 掲示板(VB.NET 掲示板)

という記載を発見。

でも、参照設定に、DAO 12.0なんて見当たらない。
そもそも、ACEDAO.DLLなんて入ってるの？

DLLはあった。
じゃあ、どれを参照すればいいの？？？

オブジェクトブラウザーで「DAO」を確認すると「Microsoft office 15.0 Access database engine Object」に含まれているんですね。

ふひろ通信: Microsoft Access 2013の参照設定で「Microsoft DAO 3.6 Object Library」を有効にしようとすると警告が出る

これ（Microsoft Office 15.0 Access database engine Object Library）か？

参照設定チェックしてみると

オブジェクトブラウザに、dbVersion120の文字が表示された！
コンパイルもOK。
いざ、実行。
エラーの発生もなく、無事終了。

ダミーのデータ10万件をinsert後、全てdeleteしてから
最適化処理でファイルサイズが小さくなっているのを確認。
（拡張子".tmp"となっているのが最適化実行直後（リネーム前））

最終的なコードは、これ

'参照設定
'Microsoft Office 15.0 Access database engine Object Library

Public Sub compactDB()

    Dim sSrcPath    As String
    Dim sDestPath   As String

    '最適化するファイルのパス
    sSrcPath = "C:\Datas\sample.accdb"

    '最適化後のファイル名
    sDestPath = sSrcPath & ".tmp"

    On Error GoTo ERR_COMPACT_DB

    '最適化の実行
    DBEngine.CompactDatabase sSrcPath, sDestPath, DAO.LanguageConstants.dbLangJapanese, DAO.DatabaseTypeEnum.dbVersion120
    '冗長に書いているが、下記でもOK
    'DBEngine.CompactDatabase sSrcPath, sDestPath, dbLangJapanese, dbVersion120

    '最適化前のファイルを削除
    Kill sSrcPath

    '最適化後のファイル名を最適化前のファイル名にリネーム
    Name sDestPath As sSrcPath

ERR_COMPACT_DB:
    If Err.Number <> 0 Then
        Debug.Print "[" & CStr(Err.Number) & "]" & Err.Description
    Else
        Debug.Print "Done."
    End If

End Sub

自分一人で使うやつなので、エラー処理は最低限。
あと、参照設定の15.0の部分は、Officeのバージョンで変わるらしい。

mdbの場合は、dbVersion120の代わりに、dbVersion40を使えばいけるのかな？（未確認）

参考サイト
DBEngine.CompactDatabase method (DAO) | Microsoft Docs
DatabaseTypeEnum enumeration (DAO) | Microsoft Docs

VBAのDictionaryのItemに動的配列を格納する

C++のmultimapのように、特定のキーに対し、複数のデータをDictionaryに格納できないか？
キー毎にデータ数が異なる場合、最大データ数を求めてから固定長配列を格納するのは無駄だし、
実際にデータがいくつ入っているか先頭から当たっていかないとわからなそう。
それは、やりたくない。

で、動的配列をItemとして格納してみたら、案外あっさりと出来ました。

ワークシートから読み込んだ地名の先頭１文字をキーとして、その地名を配列にしてItemに格納する例です。

Public Sub dicTest()

    Dim dicAddress  As New Dictionary
    Dim sAddress()  As String
    Dim sKey        As String
    Dim lItems      As Long
    Dim sValue      As String
    Dim lRow        As Long
    Dim i           As Long

    lRow = 1

    lItems = 0
    ReDim sAddress(lItems)

    With ThisWorkbook.Worksheets("Sheet1")
        sValue = .Cells(lRow, 1).Value

        Do Until (Len(sValue) = 0)

            sKey = Left$(sValue, 1)

            If dicAddress.Exists(sKey) = True Then
                'キーありなら、格納されている配列を取得
                sAddress = dicAddress.Item(sKey)

                lItems = UBound(sAddress) + 1

                '配列の要素数をひとつ増やす
                ReDim Preserve sAddress(lItems)
            Else
                'キーなしなら、１個分のデータを格納できるよう、配列を初期化
                lItems = 0

                ReDim sAddress(lItems)
            End If

            sAddress(lItems) = sValue

            '配列を格納
            dicAddress(sKey) = sAddress

            lRow = lRow + 1

            sValue = .Cells(lRow, 1).Value

            'Dictionaryには、コピーされた配列が格納される（ようです）。
            '消さなくても試した限りでは問題はなさそうだけど、残して何度も使い回すのは気持ち悪いので消す。
            Erase sAddress
        Loop
    End With

    '格納したデータを書き出す
    Debug.Print "----- い -----"
    For i = 0 To UBound(dicAddress.Item("い"))
        Debug.Print dicAddress.Item("い")(i)
    Next i

    Debug.Print "----- お -----"
    For i = 0 To UBound(dicAddress.Item("お"))
        Debug.Print dicAddress.Item("お")(i)
    Next i

End Sub

テストデータは
---------------------------------
あきる野市
あわら市
あま市
あさぎり町
おいらせ町
いわき市
つくばみらい市
さいたま市
いすみ市
おおい町
いなべ市
いの町
いちき串木野市
---------------------------------

実行結果は、
----- い -----
いわき市
いすみ市
いなべ市
いの町
いちき串木野市
----- お -----
おいらせ町
おおい町

こんな感じ。

ポイントは、

１．キーがあった時の、データ（動的配列）の取り出し方。
２．データを追するのためのReDim PreserveとReDimの使い方。
３．データ読み出し時の指定方法dicAddress.Item("い")(i)
あたりでしょうか。

まあ、ちょっとしたネタなので、「もっといい方法がある」とか突っ込まないで下さい。

こんなのもあります。

z1000s.hatenablog.com

ExcelのVBAで使えるDLLを、C++（Visual Studio 2017）で作る。・・・その１

ExcelのVBAでもそこそこの事は出来るけれど、C++で処理したい事があって「DLLにしちゃえ」と思ったはいいが、いろいろと忘れて（いや、覚えてないから忘れられないだろうorz）作るのが大変だったので、まとめてみることにした。

とりあえず、今回は、何もしない、何も返さない関数を含むDLLをビルドして、VBAから呼び出して、エラーが出ない事を確認するまで。

何らかの値を渡して、何らかの処理をした結果を返してもらうのは、次回以降に・・・

1. 開発環境
2. DLLの作り方（基礎編）
3. 使い方（Excelからの呼び出し方）

開発環境

OS：Windows 10 Professional
DLL：Microsoft Visual Studio Community 2017（Microsoft Visual C++ 2017）
VBA：Microsoft Office Personal 2013（Microsoft Excel 2013）

DLLの作り方（基礎編）

プロジェクトの作成

１．Visual Studioを起動
２．「ファイル」-「新規作成」-「プロジェクト」をクリック

３．「Visual C++」-「Windows デスクトップ」-「ダイナミック リンク ライブラリ (DLL)」をクリック

４．「名前」「場所」「ソリューション名」を指定し、「OK」をクリック
「ソリューションのディレクトリを作成」にチェックが入っていないと、ソリューション名は指定できないので、作成する場合はチェックする。
ソリューションのディレクトリを作成するかどうかは任意。今回は作成した状態で説明しています。作成しない場合は、適宜読み替えて下さい。

サイトに寄っては、Visual Studioを「管理者として実行しないとDLLが作れない」と書かれている所もあるようですが、私の場合は通常の起動でも作成出来ました。

モジュール定義ファイル（defファイル）

VBAからアクセスしやすいように、モジュール定義ファイルを追加します。
１．「プロジェクト」-「新しい項目の追加」をクリック。

２．「インストール済み」-「Visual C++」-「コード」-「モジュール定義ファイル (.def)」をクリック

３．名前をプロジェクト名.def（AccessibleFromVBA.def）として、「追加」ボタンをクリック

プロジェクトの設定

プロジェクトのプロパティを変更します。

 １．「プロジェクト」-「プロパティ」をクリック

２．構成を"アクティブ(Debug)"から"すべての構成"に変更します

３．「構成プロパティ」-「全般」-「プロジェクトの既定値」-「文字セット」を"マルチ バイト文字セット" "Unicode 文字セットを使用する"に変更します。（2019/9/25 訂正）

４．「構成プロパティ」-「全般」-「全般」-「出力ディレクトリ」を"$(SolutionDir)$(Configuration)\"から"$(ProjectDir)$(Configuration)\"に変更します。
（この操作は必須ではありません。）

５．「構成プロパティ」-「リンカー」-「モジュール定義ファイル」の値が、先程作成したモジュール定義ファイル名（AccessibleFromVBA.def）になっているか確認します。

６．「適用」ボタンをクリック

プリコンパイル済みヘッダーは、使わなくてもいいと思ったが、とりあえずそのまま使用することに。

関数を追加してみる

まずは、何もしない関数を追加してみる。

ヘッダーファイル

デフォルトでヘッダーファイルが無いので、追加する。
１．「プロジェクト」-「新しい項目の追加」をクリック。

２．「インストール済み」-「Visual C++」-「コード」-「ヘッダー ファイル (.h)」をクリック

３．名前をプロジェクト名.h（AccessibleFromVBA.h）として、「追加」ボタンをクリック

４．まずは、おまじない。

#pragma once

extern "C" {
#define ACCESSIBLEFROMVBA_API __declspec(dllexport)
}

#pragma onceについてはこちらを参照。

extern "C"については、ロベールのＣ＋＋教室 - 第４７章 Ｃ±± -あたりを見るか、自分でググって下さい。

"#define ACCESSIBLEFROMVBA_API __declspec(dllexport)"については、以下を参照。

DLL のビルド時には通常、エクスポートする関数のプロトタイプやクラスを含むヘッダー ファイルを作成し、そのヘッダー ファイル内の宣言に __declspec(dllexport) を追加します。 コードを読みやすくするために、次のように __declspec(dllexport) 用のマクロを定義して、そのマクロをエクスポートする各シンボルに使います。
__declspec(dllexport) を使った DLL からのエクスポート

#define・・・は、externの{}の外の方がいいかもしれないけど、今回は、C++ & VBA Onlyなのでこれでよしとする。

５．extern "C"の後の{}内に関数を宣言する。
今回は、引数を取らず、何も返さない"DoNothing"という関数を追加してみる。

-----　重　要　-----
戻り値の型と関数名の間にWINAPIを忘れないように。

#pragma once

extern "C" {
#define ACCESSIBLEFROMVBA_API __declspec(dllexport)
    ACCESSIBLEFROMVBA_API void WINAPI DoNothing();
}

赤い波線が出て来るが気にしない。

ソースファイル

関数の宣言が出来たら、次は定義の作成。
１．ソリューションエクスプローラーで、AccessibleFromVBA.cppをクリック（or ダブルクリック）
２．前項で作ったヘッダーファイルのインクルードを確認。無ければ追記。

３．宣言に合わせて関数を作成。今回は何もしないので、関数の中身は"return;"のみ

#include "stdafx.h"
#include "AccessibleFromVBA.h"

ACCESSIBLEFROMVBA_API void WINAPI DoNothing()
{
    return;
}

モジュール定義ファイル

１．ソリューションエクスプローラーで、AccessibleFromVBA.defをクリック（or ダブルクリック）

２．"LIBRARY"の後ろに、DLL名を追記。
３．"EXPORTS"と追記。
４．エクスポートする関数名を追記。

以前は、関数名の後ろに"@"と数字を付けていたけど、特定の場合を除き付けることはお勧めではないようです。

@ordinal を使用して、関数名ではなく番号が DLL のエクスポート テーブルに格納されるように指定できます。 多くの Windows DLL で、レガシ コードをサポートするために序数がエクスポートされます。 DLL のサイズを最小限に抑えるのに役立つため、16 ビットの Windows コードでは序数を使用することが一般的でした。 レガシ サポートのために DLL のクライアントで必要な場合を除き、関数を序数でエクスポートすることはお勧めしません。 .LIB ファイルには序数と関数のマッピングが含まれているため、DLL を使用するプロジェクトでは通常と同様に関数名を使用できます。
EXPORTS

ビルド

１．「ビルド」-「AccessibleFromVba のビルド」をクリック

２．出力ウィンドウに、"ビルド: 1 正常終了、0 失敗、0 更新不要、0 スキップ"と表示されればOK

出力先のフォルダに、"AccessibleFromVba.dll"が出来ているはず。

使い方

Excel

Declare ステートメント

１．構文
[ Public|Private ] Declare Sub name Lib "libname" [ Alias "aliasname" ] [ ( [ arglist ] ) ]
[ Public|Private ] Declare Function name Lib "libname" [ Alias "aliasname" ] [ ( [ arglist ] ) ] [ As type ]

指定項目	説明	備考
name	関数名	前述の例では、DoNothing
libname	DLL名	必要であればパスも含めて指定
aliasname	DLL またはコード リソース内のプロシージャの名前	多分気にしなくてもOK
arglist	プロシージャが呼び出されるときにプロシージャに渡される引数を表す変数のリスト	オプション
type	Function プロシージャによって返される値のデータ型	オプション。VBAの型を指定

詳細はこちらとか こちら。

DoNothingの例

標準モジュールに、以下の１行を追記。（パスは自分の環境に合わせて下さい。）

Private Declare Sub DoNothing Lib "C:\Datas\MyDatas\Developer\VisualStudioComunity2017\DllForVBA\AccessibleFromVBA\Debug\AccessibleFromVBA.dll" ()

以下のように呼び出す。

Public Sub DllCallTest()

    'DLLの関数呼び出し
    Call DoNothing

    Debug.Print "Done."

End Sub

エラーの発生もなく、無事終了。

次回予告

今回の内容では、投げっぱなしの処理しか出来ないので、次回はデータの受け渡しに関連する事をまとめる予定。

1. 受け渡しするデータの型について
2. 値渡しと参照渡しについて
3. 処理する値を渡せるようにすること
4. 処理した結果や値を返してもらえるようにすること
5. データ型による渡し方の注意点

それ以降は、

• DLLからエクスポートされる関数の確認方法
• DLLのデバッグ方法

などをまとめる予定。

いつ頃までに、まとめられるかは、不明・・・
気分次第？

2018/6/27

やっと、その２を追加しました。
予告までしたのに、遅いし、予告した内容も一部次に先送りしてるし・・・orz

z1000s.hatenablog.com

2019/10/22

その３ 文字列の受け渡しを追加しました。

z1000s.hatenablog.com

z1000s.hatenablog.com

z1000s.hatenablog.com

z1000s.hatenablog.com

z1000s.hatenablog.com

z1000s.hatenablog.com