VBAのDictionaryに配列を格納して、変更してみる

どうせなので、多次元配列（３次元だけど）にしてみた。
テスト用データ

その１　配列を格納してみる

Public Sub Dictionaryに配列を追加()

    Dim dicValues   As Dictionary
    Dim lValues(1, 1, 1) As Long
    Dim lKey  As Long
    Dim i   As Long
    Dim j   As Long
    Dim k   As Long

    Set dicValues = New Dictionary

    With ThisWorkbook.Worksheets("Sheet2")
        For i = 2 To 9
            lValues(.Cells(i, 1).Value, .Cells(i, 2).Value, .Cells(i, 3).Value) = .Cells(i, 4).Value
        Next i

        'キー値　0で配列を追加
        dicValues.Add 0, lValues

        Erase lValues

        For i = 10 To 17
            lValues(.Cells(i, 1).Value - 2, .Cells(i, 2).Value, .Cells(i, 3).Value) = .Cells(i, 4).Value
        Next i

        'キー値　1で配列を追加
        dicValues.Add 1, lValues
    End With

    '
    Debug.Print "Dictionary.Itemは配列？：" & IsArray(dicValues.Item(0))
    Debug.Print

    For lKey = 0 To dicValues.Count - 1
        Debug.Print "キー：" & CStr(lKey)

        For i = 0 To UBound(lValues, 1)
            For j = 0 To UBound(lValues, 2)
                For k = 0 To UBound(lValues, 3)
                    Debug.Print i; j; k, dicValues.Item(lKey)(i, j, k)
                Next k
            Next j
        Next i
    Next lKey

End Sub

実行してみる。

call Dictionaryに配列を追加
Dictionary.Itemは配列？：True

キー：0
0 0 0 10000
0 0 1 10001
0 1 0 10010
0 1 1 10011
1 0 0 10100
1 0 1 10101
1 1 0 10110
1 1 1 10111
キー：1
0 0 0 20200
0 0 1 20201
0 1 0 20210
0 1 1 20211
1 0 0 20300
1 0 1 20301
1 1 0 20310
1 1 1 20311

dicValues.Item(lKey)　これ自体は配列なんですね。
だから、dicValues.Item(lKey)(i, j, k)という形でアクセス出来るんですね。

その２　追加した配列をまるまる置き換えてみる

Public Sub Dictionaryに追加した配列をまるまる置換()

    Dim dicValues   As Dictionary
    Dim lValues(1, 1, 1) As Long
    Dim lKey    As Long
    Dim i   As Long
    Dim j   As Long
    Dim k   As Long

    Set dicValues = New Dictionary

    With ThisWorkbook.Worksheets("Sheet2")
        For i = 2 To 9
            lValues(.Cells(i, 1).Value, .Cells(i, 2).Value, .Cells(i, 3).Value) = .Cells(i, 4).Value
        Next i

        '同じ配列をキー値　0と1で追加
        dicValues.Add 0, lValues
        dicValues.Add 1, lValues

        For i = 10 To 17
            lValues(.Cells(i, 1).Value - 2, .Cells(i, 2).Value, .Cells(i, 3).Value) = .Cells(i, 4).Value
        Next i

        'キー値　1のItemを値の異なる配列で書き換え
        dicValues.Item(1) = lValues
    End With

    For lKey = 0 To dicValues.Count - 1
        Debug.Print "キー：" & CStr(lKey)

        For i = 0 To UBound(lValues, 1)
            For j = 0 To UBound(lValues, 2)
                For k = 0 To UBound(lValues, 3)
                    Debug.Print i; j; k, dicValues.Item(lKey)(i, j, k)
                Next k
            Next j
        Next i
    Next lKey

End Sub

実行してみる。

call Dictionaryに追加した配列をまるまる置換
キー：0
0 0 0 10000
0 0 1 10001
0 1 0 10010
0 1 1 10011
1 0 0 10100
1 0 1 10101
1 1 0 10110
1 1 1 10111
キー：1
0 0 0 20200
0 0 1 20201
0 1 0 20210
0 1 1 20211
1 0 0 20300
1 0 1 20301
1 1 0 20310
1 1 1 20311

きちんと置き換わっている。

その３　”追加した配列の要素”だけ変更出来るか？

Public Sub Dictionaryに追加した配列の要素を変更()

    Dim dicValues   As Dictionary
    Dim lValues(1, 1, 1) As Long

    Set dicValues = New Dictionary

    With ThisWorkbook.Worksheets("Sheet2")
        'キー値　0で無変更の配列を追加
        dicValues.Add 0, lValues

        'キー指定して、配列の要素を変更
        dicValues.Item(0)(0, 0, 0) = .Cells(10, 4).Value

        If dicValues.Item(0)(0, 0, 0) <> .Cells(10, 4).Value Then
            Debug.Print "Not equal! orz " & vbCrLf; dicValues.Item(0)(0, 0, 0); .Cells(10, 4).Value
        End If
    End With

End Sub

実行してみる。

call Dictionaryに追加した配列の要素を変更
Not equal! orz
0 20200

値は変わっていない。
dicValues.Item(0)を内容の異なる配列で上書きすることは出来るけれど
その要素dicValues.Item(0)(0, 0, 0)を書き換える事は出来ないみたい。
エラーは出ずに処理は終了するんだけどねぇ・・・
読み取り専用のような感じ。

やっぱり一旦データを変数に取り出して、編集後に再度設定するしかないのかもしれない。

VBAで休日判定処理を使って、Excelワークシートに休日カレンダーを作る

休日判定を作ったので、その応用を２。

Excelのワークシートに休日を指定色にしたカレンダーを作成してみる。
（ソースコードは下の方に・・・）

仕様みたいなもの

通常（？）の１週間横並び

• 年指定（１月から１２月）
• 年度指定（４月から翌年３月）

オプション

• 横１行に表示する月数を可変
• 書き込み基準位置指定可能
• 月と月の間のセル数可変（縦、横）
• 曜日と曜日の間のセル数可変
• 週と週の間のセル数可変
• 休日色（背景、文字）可変

縦

• 日付、曜日、休日名表示
• 書き込み基準位置指定可能

サンプル画像

（４月２９日とか、通常の休日を非休日と設定している部分もあるので、普通の正しい（？）カレンダーとは異なるのでご注意を。）
１月から１２月（３×４）

１月から１２月（４×３）

１月から１２月（６×２）

１月から１２月（３×４、日間セルあり）

４月から３月（３×４）

縦

事前準備

休日判定処理クラスの休日設定（の確認）

パブリックメソッド

• createCalendarY（指定年の１月から１２月までのカレンダー作成）
• createCalendarYD（指定年度の４月から３月までのカレンダー作成）
• createCalendarYMV（指定年月の縦カレンダー作成）

ソースコード

Option Explicit


'//////////////////////////////////////////////////
'                   概　　要
'//////////////////////////////////////////////////
'
'用　　　途：カレンダー作成
'備　　　考：休日判定処理クラス（CCompanyHoliday）が別途必要です。
'処理対象日：休日判定処理クラス（CCompanyHoliday）に依存します。
'作　　　成：2018/09/09


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

'--------------------------------------------------
'               カレンダー共通
'--------------------------------------------------

'カレンダーを作成するワークシートのプレフィックス
Private Const TARGET_SHEET_PREFIX   As String = "Calendar"

'休日色
Private Const HOLIDDAY_BACK_COLOR   As Long = vbRed
Private Const HOLIDDAY_FORE_COLOR   As Long = vbWhite


'--------------------------------------------------
'               カレンダー（BOX）
'--------------------------------------------------

'カレンダー書き込み基準セル（左上）
Private Const REFERENCE_ROW         As Long = 2
Private Const REFERENCE_COL         As Long = 2

'ヘッダ行数（月、曜日）
Private Const HEADER_ROWS           As Long = 3

'月間隔（行）
Private Const LINE_SPACING_MONTH    As Long = 2
'月間隔（列）
Private Const COLUMN_SPACING_MONTH  As Long = 2

'日間隔（行）
Private Const LINE_SPACING_DAY      As Long = 1
'日間隔（列）
Private Const COLUMN_SPACING_DAY    As Long = 1

'１行に表示する月数
Private Const MONTHS_IN_LINE        As Long = 3

'カレンダー書き込みモード
Private Enum CalendarPrintMode
    enm01To12
    enm04To03
End Enum

'カレンダーセルのサイズ
Private Const CALENDAR_COL_WIDTH    As Double = 3.25
Private Const CALENDER_ROW_HEIGHT   As Double = 14.25


'--------------------------------------------------
'               カレンダー（縦）
'--------------------------------------------------

'カレンダー書き込み基準セル（左上）
Private Const REFERENCE_ROW_V       As Long = 2
Private Const REFERENCE_COL_V       As Long = 1

'項目の表示列（基準セルからの列方向オフセット）
Private Const CALENDER_V_DATE_COL_INDEX           As Long = 0
Private Const CALENDER_V_WEEKDAY_COL_INDEX        As Long = 1
Private Const CALENDER_V_HOLIDAY_NAME_COL_INDEX   As Long = 2


'++++++++++++++++++++++++++++++++++++++++++++++++++
'               パブリックメソッド
'++++++++++++++++++++++++++++++++++++++++++++++++++

'//////////////////////////////////////////////////
'
'機　　　能：指定年の１月から１２月までのカレンダー作成
'パラメータ：
'           lYear：作成するカレンダーの年
'備　　　考：
'
'//////////////////////////////////////////////////
Public Sub createCalendarY(ByVal lYear As Long)

    Dim ws      As Worksheet
    Dim r       As Range
    Dim cch     As CCompanyHoliday
    Dim i       As Long

    'カレンダーを作成するワークシート取得
    Set ws = getTargetSheet(lYear)

    Set cch = New CCompanyHoliday

    For i = 1 To 12
        '月の基準位置を取得
        Set r = getReferenceRange(ws, i, enm01To12)

        '指定月のカレンダー書き込み
        Call createCalendarSub(cch, r, lYear, i)
    Next i

    Set cch = Nothing

    Debug.Print "Done."

End Sub

'//////////////////////////////////////////////////
'
'機　　　能：指定年度の４月から３月までのカレンダー作成
'パラメータ：
'           lYear：作成するカレンダーの年度
'備　　　考：
'
'//////////////////////////////////////////////////
Public Sub createCalendarYD(ByVal lYear As Long)

    Dim ws      As Worksheet
    Dim r       As Range
    Dim cch     As CCompanyHoliday
    Dim i       As Long

    'カレンダーを作成するワークシート取得
    Set ws = getTargetSheet(lYear)

    Set cch = New CCompanyHoliday

    For i = 4 To 12
        '月の基準位置を取得
        Set r = getReferenceRange(ws, i, enm04To03)

        '指定月のカレンダー書き込み
        Call createCalendarSub(cch, r, lYear, i)
    Next i

    For i = 1 To 3
        '月の基準位置を取得
        Set r = getReferenceRange(ws, i, enm04To03)

        '指定月のカレンダー書き込み
        Call createCalendarSub(cch, r, lYear + 1, i)
    Next i

    Set cch = Nothing

    Debug.Print "Done."

End Sub

'//////////////////////////////////////////////////
'
'機　　　能：指定年月の縦カレンダー作成
'パラメータ：
'           lYear           ：作成するカレンダーの最初の月の年
'           lBeginMonth     ：作成するカレンダーの最初の月
'           lMonthes        ：作成するカレンダーの月数
'           printHolidayName：休日名を出力するか
'                               True ：出力する
'                               False：出力しない
'備　　　考：
'
'//////////////////////////////////////////////////
Public Sub createCalendarYMV(ByVal lYear As Long, _
                             ByVal lBeginMonth As Long, _
                             ByVal lMonthes As Long, _
                             Optional ByVal printHolidayName As Boolean = False)

    Dim ws      As Worksheet
    Dim r       As Range
    Dim cch     As CCompanyHoliday
    Dim i       As Long

    'カレンダーを作成するワークシート取得
    Set ws = getTargetSheet(lYear)

    Set r = ws.Cells(REFERENCE_ROW_V, REFERENCE_COL_V)

    Set cch = New CCompanyHoliday

    '指定月のカレンダー書き込み
    Call createCalendarVSub(cch, r, lYear, lBeginMonth, lMonthes, printHolidayName)

    Set cch = Nothing

    Debug.Print "Done."

End Sub


'++++++++++++++++++++++++++++++++++++++++++++++++++
'               プライベートメソッド
'++++++++++++++++++++++++++++++++++++++++++++++++++

'カレンダーを作成するワークシートの取得
Private Function getTargetSheet(ByVal lYear As Long) As Worksheet

    Dim ws          As Worksheet
    Dim s           As Worksheet
    Dim sSheetName  As String

    'カレンダーを作成するシート名
    sSheetName = TARGET_SHEET_PREFIX & CStr(lYear)

    '指定シート名を検索
    For Each s In ThisWorkbook.Worksheets
        If s.Name = sSheetName Then
            '見つかったら変数にセットし、クリア
            Set ws = ThisWorkbook.Worksheets(sSheetName)

            With ws
                .Range(.Cells(1, 1), .Cells(.Rows.Count, .Columns.Count)).Clear
            End With

            Exit For
        End If
    Next s

    If ws Is Nothing Then
        '見つからなかったらシートを作成
        With ThisWorkbook.Worksheets
            Set ws = .Add(after:=ThisWorkbook.Worksheets(.Count))
        End With

        'リネーム
        ws.Name = sSheetName
    End If

    With ws.Cells
        .ColumnWidth = CALENDAR_COL_WIDTH
        .RowHeight = CALENDER_ROW_HEIGHT
    End With

    Set getTargetSheet = ws

End Function

'カレンダー書き込み
Private Sub createCalendarSub(ByRef cch As CCompanyHoliday, _
                              ByRef r As Range, _
                              ByVal lYear As Long, _
                              ByVal lMonth As Long)

    Dim dtBegin As Date
    Dim dtEnd   As Date
    Dim dtDate  As Date
    Dim lDays   As Long
    Dim lRowIndex   As Long
    Dim lColIndex   As Long
    Dim lRowOffset  As Long
    Dim lColOffset  As Long
    Dim i       As Long

    Const WEEKDAYS  As String = "日月火水木金土"

    dtBegin = DateSerial(lYear, lMonth, 1)
    dtEnd = DateSerial(lYear, lMonth + 1, 0)

    '月
    r.Value = StrConv(CStr(lMonth), vbWide) & "月"

    '曜日
    lRowOffset = HEADER_ROWS - 1

    For i = 0 To 6
        lColOffset = i * (COLUMN_SPACING_DAY + 1)
        r.Offset(lRowOffset, lColOffset).Value = Mid$(WEEKDAYS, i + 1, 1)
    Next i

    lRowIndex = 0
    lColIndex = Weekday(dtBegin) - vbSunday

    'カレンダー書き込み
    With r
        For i = 0 To Day(dtEnd) - 1
            '基準位置からのオフセット計算
            lRowOffset = lRowIndex * (LINE_SPACING_DAY + 1) + HEADER_ROWS
            lColOffset = lColIndex * (COLUMN_SPACING_DAY + 1)

            '日付書き込み
            .Offset(lRowOffset, lColOffset).Value = i + 1

            dtDate = DateAdd("d", i, dtBegin)

            '休日判定
            If cch.isCompanyHoliday(dtDate) Then
                .Offset(lRowOffset, lColOffset).Interior.Color = HOLIDDAY_BACK_COLOR
                .Offset(lRowOffset, lColOffset).Font.Color = HOLIDDAY_FORE_COLOR
            End If

            lColIndex = lColIndex + 1

            If lColIndex Mod 7 = 0 Then
                lColIndex = 0

                lRowIndex = lRowIndex + 1
            End If
        Next i
    End With

End Sub

'カレンダー（縦）書き込み
Private Sub createCalendarVSub(ByRef cch As CCompanyHoliday, _
                               ByRef r As Range, _
                               ByVal lYear As Long, _
                               ByVal lBeginMonth As Long, _
                               ByVal lMonthes As Long, _
                               ByVal printHolidayName As Boolean)

    Dim dtBegin As Date
    Dim dtEnd   As Date
    Dim dtDate  As Date
    Dim lDays   As Long
    Dim sHolidayName    As String
    Dim i       As Long

    Const WEEKDAYS  As String = "日月火水木金土"

    dtBegin = DateSerial(lYear, lBeginMonth, 1)
    dtEnd = DateSerial(lYear, lBeginMonth + lMonthes, 0)

    lDays = DateDiff("d", dtBegin, dtEnd) + 1

    'カレンダー書き込み
    With r
        For i = 0 To lDays - 1
            dtDate = DateAdd("d", i, dtBegin)

            '日付書き込み
            .Offset(i, CALENDER_V_DATE_COL_INDEX).Value = dtDate
            .Offset(i, CALENDER_V_WEEKDAY_COL_INDEX).Value = Mid$(WEEKDAYS, Weekday(dtDate), 1)

            '休日判定
            If cch.isCompanyHoliday2(dtDate, sHolidayName) Then
                .Offset(i, CALENDER_V_WEEKDAY_COL_INDEX).Interior.Color = HOLIDDAY_BACK_COLOR
                .Offset(i, CALENDER_V_WEEKDAY_COL_INDEX).Font.Color = HOLIDDAY_FORE_COLOR

                If printHolidayName Then
                    .Offset(i, CALENDER_V_HOLIDAY_NAME_COL_INDEX).Value = sHolidayName
                End If
            End If
        Next i

        .Offset(0, CALENDER_V_DATE_COL_INDEX).EntireColumn.AutoFit
        .Offset(0, CALENDER_V_WEEKDAY_COL_INDEX).EntireColumn.AutoFit
        If printHolidayName Then
            .Offset(0, CALENDER_V_HOLIDAY_NAME_COL_INDEX).EntireColumn.AutoFit
        End If
    End With

End Sub

'指定年月のカレンダー書き込み基準位置取得
Private Function getReferenceRange(ByRef ws As Worksheet, _
                                   ByVal lMonth As Long, _
                                   ByVal lPrintMode As CalendarPrintMode) As Range

    '１ヶ月の最大週数
    Const MAX_WEEKS_IN_MONTH    As Long = 6

    Dim lLinesInMonth   As Long
    Dim lColsInMonth    As Long
    Dim lMonthW As Long
    Dim lNthV   As Long
    Dim lNthH   As Long
    Dim lRow    As Long
    Dim lCol    As Long

    '１ヶ月を表示するのに必要な行数
    lLinesInMonth = HEADER_ROWS + MAX_WEEKS_IN_MONTH + (MAX_WEEKS_IN_MONTH - 1) * LINE_SPACING_DAY

    If lPrintMode = CalendarPrintMode.enm04To03 Then
        Select Case lMonth
        Case 1 To 3
            lMonthW = lMonth + 9
        Case 4 To 12
            lMonthW = lMonth - 3
        End Select
    Else
        lMonthW = lMonth
    End If

    '指定月が何段目に表示されるか
    lNthV = (lMonthW + MONTHS_IN_LINE - 1) \ MONTHS_IN_LINE

    lRow = REFERENCE_ROW + (lNthV - 1) * (lLinesInMonth + LINE_SPACING_MONTH)

    '１ヶ月を表示するのに必要な列数
    lColsInMonth = 7 + (7 - 1) * COLUMN_SPACING_DAY

    '指定月が何列目に表示されるか
    lNthH = lMonthW Mod MONTHS_IN_LINE

    If lNthH Mod MONTHS_IN_LINE = 0 Then
        lNthH = MONTHS_IN_LINE
    End If

    lCol = REFERENCE_COL + (lNthH - 1) * (lColsInMonth + COLUMN_SPACING_MONTH)

    Set getReferenceRange = ws.Cells(lRow, lCol)

End Function

モジュール先頭の定数を適当にいじって、いろいろ試してみて下さい。

余談

今回の処理は、Excel限定なので、クラスモジュールの祝日定義のデータを、クラスモジュールからワークシートに移したほうが間違いなく使いやすく（メンテナンスしやすく）なります。
もし、本気で使おうとする（がんばりやさんの）方がいたら、ぜひ挑戦（？）してみて下さい。
祝日情報生成のたぐいのメソッドのインターフェイスを変えずに中身のみ変えれば出来ます。
空腹おやじは、そこまで元気がありませんので・・・

VBAで休日判定処理を使って、指定営業日数後の日付を取得する

休日判定処理を作ったので、その応用を。

「翌営業日の日付が知りたい」とか、そういった類です。
休日判定クラスモジュールを用意して、それとは別に標準モジュールを用意して、以下のコードを貼り付けます。
あとは、getNthWorkingDayに必要なパラメータを渡して呼び出します。
日数は、マイナスをつけることで、過去方向も指定できるようにしてあります。
エラー処理はあまり入れてません。（手抜きです）

Option Explicit


'//////////////////////////////////////////////////
'                   概　　要
'//////////////////////////////////////////////////
'
'用　　　途：営業日取得
'備　　　考：休日判定処理クラス（CCompanyHoliday）が別途必要です。
'処理対象日：休日判定処理クラス（CCompanyHoliday）に依存します。
'作　　　成：2018/09/09


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

Private cch_    As CCompanyHoliday


'++++++++++++++++++++++++++++++++++++++++++++++++++
'               パブリックメソッド
'++++++++++++++++++++++++++++++++++++++++++++++++++

'//////////////////////////////////////////////////
'
'機　　　能：指定日を基準に、指定営業日数だけ移動した日付を取得する
'パラメータ：
'           dtBegin ：基準日
'           lDays   ：移動する日数（負数でも可）
'           dtResult：移動した日付
'復　帰　値：
'備　　　考：
'
'//////////////////////////////////////////////////
Public Function getNthWorkingDay(ByVal dtBegin As Date, ByVal lDays As Long, ByRef dtResult As Date) As Boolean

    Const VALID_FIRST_YEAR  As Long = 1948

    Dim dtBeginW    As Date
    Dim dtTemp      As Date
    Dim lAddedDays  As Long
    Dim lWorkingDays    As Long
    Dim lStep       As Long
    Dim lInitializedYear    As Long

    getNthWorkingDay = True

    dtBeginW = DateSerial(Year(dtBegin), Month(dtBegin), Day(dtBegin))

    If lDays = 0 Then
        dtResult = dtBeginW

        Exit Function
    End If

    If cch_ Is Nothing Then
        Set cch_ = New CCompanyHoliday
    End If

    lInitializedYear = cch_.InitializedLastYear

    lAddedDays = 0

    lStep = Sgn(lDays)

    Do Until lWorkingDays = lDays

        lAddedDays = lAddedDays + lStep

        dtTemp = DateAdd("d", lAddedDays, dtBeginW)

        If Year(dtTemp) > lInitializedYear Then
            lInitializedYear = Year(dtTemp)

            Call cch_.reInitialize(lInitializedYear)
        ElseIf Year(dtTemp) <= VALID_FIRST_YEAR Then
            '「国民の祝日に関する法律」施行年以前ならエラーとする
            '厳密には1948/7/20施行であるが、
            '簡略化のため1948/12/31以前ならエラーにしている
            getNthWorkingDay = False

            Exit Function
        End If

        If cch_.isCompanyHoliday(dtTemp) = False Then
            lWorkingDays = lWorkingDays + lStep
        End If
    Loop

    dtResult = DateAdd("d", lAddedDays, dtBeginW)

    Set cch_ = Nothing

End Function

実務レベルで、繰り返し使うようなことでもなければ
このサンプルのように、cch_ をモジュールレベルの変数にする必要はないです。
ローカル変数で問題がない場合は、だまってローカル変数にしましょう。
（なぜこうしたかは、気にしないでください）

呼び出しサンプル

Public Sub Test()

    Dim d1 As Date
    Dim d2 As Date
    Dim diff As Long

    d1 = #8/23/2018#

    diff = 9
    Call getNthWorkingDay(d1, diff, d2)
    Debug.Print d1, diff, d2

    diff = -5
    Call getNthWorkingDay(d1, diff, d2)
    Debug.Print d1, diff, d2

End Sub

以下のようなカレンダーに対して実行してみた例

call Test
2018/08/23 9 2018/09/04
2018/08/23 -5 2018/08/09

VBAによる「祝日判定処理」を「休日判定処理」に拡張してみた

３ヶ月半ほど前の５月２８日に、VBAの祝日判定コードを書いたところ思っていた以上にアクセスされているようで、「以外に需要があるものだ」と少々驚いています。（推定で平日３０件たらず？ですけど・・・）

そこで、図に乗った空腹おやじは、前回の祝日判定を拡張し、休日判定出来るようにすることにしました。（「休日でなければ・・・」という判定をすれば、営業日とか稼働日の判定にも使えそうです。）

基本は、前回の祝日判定処理を利用して、祝日定義同様に

• 月日固定の休日
• 月週曜日固定の休日
• 曜日固定の休日

を定義する処理を追加し、祝日判定の時と同様に日付指定でBool値判定。

更に、

• 特定の祝日、休日を除外できるようにする

といったところでしょうか。

クラスモジュール（CCompanyHoliday）のソースは、長いので下の方に・・・

とりあえず祝日定義は、祝日法が変わらなければ、いじる必要が必要ないと思うので
まずは、休日定義を以下の６個のメソッド内で設定してから使ってみてください。

• getCompanyHolidayInfoW（曜日固定の会社休日情報生成）
• getCompanyHolidayInfoMD（月日固定の会社休日情報生成）
• getCompanyHolidayInfoWN（月週曜日固定の会社休日情報生成）
• getCompanyHolidayInfoMDExclude（月日固定の会社出勤情報生成）
• getCompanyHolidayInfoWNExclude（月週曜日固定の会社出勤情報生成）

実行例は、こんな感じ。

Public Sub Test(ByVal lYear As Long)

    Dim cch     As CCompanyHoliday
    Dim dt()    As Date
    Dim i As Long

    Set cch = New CCompanyHoliday

    Call cch.getNationalHolidays(lYear, dt)

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

    Set cch = Nothing

End Sub

これをイミディエイトウィンドウで実行してみると

call Test(2018)
2018/01/01 元日
2018/01/02 年始休暇
2018/01/03 年始休暇
2018/01/06 会社休日
2018/01/07 会社休日
2018/01/08 成人の日
2018/01/13 会社休日
2018/01/14 会社休日
2018/01/20 会社休日
2018/01/21 会社休日
2018/01/27 会社休日
2018/01/28 会社休日
2018/02/03 会社休日
2018/02/04 会社休日
2018/02/10 会社休日
2018/02/11 建国記念の日
2018/02/12 振替休日
2018/02/17 会社休日
2018/02/18 会社休日
2018/02/24 会社休日
2018/02/25 会社休日
2018/03/03 会社休日
2018/03/04 会社休日
2018/03/10 会社休日
2018/03/11 会社休日
2018/03/17 会社休日
2018/03/18 会社休日
2018/03/21 春分の日
2018/03/24 会社休日
2018/03/25 会社休日
2018/03/31 会社休日
2018/04/01 会社休日
2018/04/07 会社休日
2018/04/08 会社休日
2018/04/14 会社休日
2018/04/15 会社休日
2018/04/21 会社休日
2018/04/22 会社休日
2018/04/28 会社休日
2018/04/30 振替休日
2018/05/03 憲法記念日
2018/05/04 みどりの日
2018/05/05 こどもの日
2018/05/06 会社休日
2018/05/12 会社休日
2018/05/13 会社休日
2018/05/19 会社休日
2018/05/20 会社休日
2018/05/26 会社休日
2018/05/27 会社休日
2018/06/02 会社休日
2018/06/03 会社休日
2018/06/09 会社休日
2018/06/10 会社休日
2018/06/16 会社休日
2018/06/17 会社休日
2018/06/18 特別休日
2018/06/23 会社休日
2018/06/24 会社休日
2018/06/30 会社休日
2018/07/01 会社休日
2018/07/07 会社休日
2018/07/08 会社休日
2018/07/14 会社休日
2018/07/15 会社休日
2018/07/16 海の日
2018/07/21 会社休日
2018/07/22 会社休日
2018/07/28 会社休日
2018/07/29 会社休日
2018/08/04 会社休日
2018/08/05 会社休日
2018/08/11 山の日
2018/08/12 お盆休暇
2018/08/13 お盆休暇
2018/08/14 お盆休暇
2018/08/15 お盆休暇
2018/08/16 お盆休暇
2018/08/17 お盆休暇
2018/08/18 お盆休暇
2018/08/19 会社休日
2018/08/26 会社休日
2018/09/01 創業記念日
2018/09/02 会社休日
2018/09/08 会社休日
2018/09/09 会社休日
2018/09/15 会社休日
2018/09/16 会社休日
2018/09/17 敬老の日
2018/09/22 会社休日
2018/09/23 秋分の日
2018/09/24 振替休日
2018/09/29 会社休日
2018/09/30 会社休日
2018/10/06 会社休日
2018/10/07 会社休日
2018/10/08 体育の日
2018/10/13 会社休日
2018/10/14 会社休日
2018/10/20 会社休日
2018/10/21 会社休日
2018/10/24 特別休日
2018/10/25 特別休日
2018/10/27 会社休日
2018/10/28 会社休日
2018/11/03 文化の日
2018/11/04 会社休日
2018/11/10 会社休日
2018/11/11 会社休日
2018/11/17 会社休日
2018/11/18 会社休日
2018/11/23 勤労感謝の日
2018/11/24 会社休日
2018/11/25 会社休日
2018/12/01 会社休日
2018/12/02 会社休日
2018/12/08 会社休日
2018/12/09 会社休日
2018/12/15 会社休日
2018/12/16 会社休日
2018/12/22 会社休日
2018/12/23 天皇誕生日
2018/12/24 振替休日
2018/12/29 年末休暇
2018/12/30 年末休暇
2018/12/31 年末休暇

クラスモジュール（CCompanyHoliday）のソースは、これ

Manjaro Linux pacmanのミラー（筑波）がエラー403

現在、2018年7月21日 21時過ぎですが
筑波のミラーがまたエラーのようです。
理研のミラーは大丈夫のようです。

マウントできなくなったHDDから、testdiskを使用して、ファイルをサルベージしてみた

USB接続で使用していた4TBのHDDが、突然使用できなくなりました。
マウントできないと・・・

根本的な原因は不明なのですが、ラベルが書き換わって、openSUSE-Leapとなっていましたし、
中途半端に、ddコマンドが実行されたような感じでしょうか？
openSUSEは、インストール用としてUSBメモリに書き込むために以前使ったことはありますが
現在は、内蔵HDDには残っていません。

主にバックアップ用として使用していたので
いろいろと大切なファイル（そう、あんなファイルやこんなファイル・・・）を保存していたので
困ってしまいました。

唯一救いだったのが、OSのインストールされたHDDではなく
外付けのHDDだったので、不要な書き込みによる上書きの心配が少なかったことでしょうか。

諦めてフォーマットしてしまおうかと思ってみたものの
少しくらいは悪あがきしてみて、駄目なら諦めようと調べてみると
testdiskというツールがあるらしく、それを使ってみることにした。

HDDの情報が書き換わったPC（Manjaro Linux）でサルベージするのも嫌だったので
別のPC（Antergos）で作業することに。

pacmanで検索すると、testdiskが見つかったので、即インストール。

端末から、コマンドを入力して開始。

最初にログの作成方法について聞いてきた。
初めてなので、新規にログを作成するので、「Create」が選択された状態でEnter
（ログは、自分のHOMEディレクトリに作成されました。　/home/z1000）

次に認識されたHDDのリストが表示されるので、対象となるHDDを選択して
[ Proceed ]を選択して、Enter

次は、パーティションテーブルの種類。
今回のLinuxの場合には、[ Intel ]を選べばOKなようです。

事前の準備が住んだところで、まずは分析
[ Analyse ]を選択して、Enter

現状で、OSが認識している状況が表示される（？）ようです。
[ Quick Search ]を選択して、Enter

そうすると、以前の状況らしきものが見えてきた。

キーボードから「P」を入力すると、ファイルリストが表示されるようです。

2018/7/3 修正
赤い文字のファイルやディレクトリは、復元できないものなのかもしれない。
赤い文字のファイルも復元はできるようです。

↑↓で、ディレクトリやファイルを選択でき、
←→で、ディレクトリの親や子に移動できるようです。

サルベージしたいファイルやディレクトリを選択し、
キーボードの「C」を押下すると、コピー先を聞いてきます。

あとは、移動先を選択し、Enterを押下すればコピーが始まります。

選択したファイルは、階層付きでコピーされました。

この調子で、他のファイルも・・・

2018/7/3 追記
USBメモリのファイルを削除して、同様に操作したら、
削除したファイルを復元できました。
復元されたファイルの所有者、グループはrootでした。
ファイル名によっては、元のファイル名を復元できない場合もあるようです。
（省略形のような名前で復元されたりする場合があるようです。）

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

次回予告までしておきながら、他にVBA関係の記事を書いていたこともあり、既に２ケ月以上が過ぎ、
「いつ頃までに、まとめられるかは、不明・・・」の記載通りになってしまった。

前回も書きましたけど、64bit版のVBAではどうなるかわかりませんので！！！

今回の内容は次の通り。

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

受け渡しするデータの型について

とりあえず必要なのは、VBAとC++のデータ型の対応。
VBA独自の型は、C++に渡せないし、逆にC++にしかない型は、VBAが受け取れない。
（条件付きであれば、例外もあるけど・・・）
VBAの主な型を中心に対応を見てみると次のような感じ。

VBAの型	C++の型	備考
Byte	unsigned char BYTE
Integer	short SHORT
Long	int long INT LONG
Single	float
Double	double
Boolean	BOOL

C++の型	VBAの型	備考
HANDLE	Long
char CHAR	Byte	最上位ビットがOFFならばそのまま使用可
unsigned short WORD	Integer	最上位ビットがOFFならばそのまま使用可
unsigned int unsigned long UINT ULONG DWORD	Long	最上位ビットがOFFならばそのまま使用可

VBAにあってC++にない型（抜粋）
Currency
Date
Decimal
String
Object
Variant

C++にあってVBAにない型（抜粋）
WCHAR
LONGLONG
ULONGLONG

VBAのString型に対応するC++の型はありません。
ちょっと特殊です。データの受け渡しにはchar型のポインタまたは、BSTR型を使用します。
これについては、次回（？）にでも・・・

処理する値を渡せるようにすること

DLLに何らかのデータ処理をしてもらうためには、必要なデータを渡してあげないと出来ません。
データはVBAの関数と同様にパラメータに引数を渡します。
ただ、C++とVBAでは、構文が違うので予め覚えておく必要があります。

値渡しと参照渡しについて

値渡し

引数のアドレスをプロシージャに渡すのではなく引数の値を渡す方法。
VBAでは、ByValを指定する事により値渡しとなる。

参照渡し

引数の値をプロシージャに渡すのではなく引数のアドレスを渡す方法。
VBAでは、デフォルトで参照渡しである。明示的に指定する場合には、ByRefを指定する。

C++の場合

値渡し

データ型の後ろに変数を指定する。
void doAnything(int hoge);　intがデータ型で、hogeが変数

値渡し

データ型の後ろに"*"を付けその後ろに変数を指定する。（ポインタですな。）
void doSomething(long* fuga);　longがデータ型で、fugaが変数

処理した結果や値を返してもらえるようにすること

値を返してもらう方法は、大きく分けて２つ。
一つは、関数の復帰値による方法。
これは、VBAでいえば、ファンクションプロシージャによる復帰値で結果を得る方法と同じ。
C++の場合には、関数名の前に復帰値のデータ型を指定する。
復帰値の型 関数名(パラメータリスト)
もう一つは、渡したパラメータにデータを入れてもらい、返してもらう方法。
こちらは、VBAでいえば、パラメータにByRefを指定し、返してもらう方法と同じ。
どちらを使うかは、状況に応じて使い分ければよろしいかと。
場合によっては、両方というのもありです。

数値型の場合の受け渡しの例

VBAからLongの値を渡して、２倍した結果を返してもらう「GetNumberI」という関数と、
３００倍した値を返してもらう「GetNumberI2」を作ってみます。
GetNumberIは、パラメータを値渡しして、復帰値で結果をもらいます。
GetNumberI2は、パラメータを参照渡しし、そのパラメータ値を変更して返してもらいます。

前回のファイルに、書き加えていきます。

まず、ヘッダファイル（AccessibleFromVBA.h）

#pragma once

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

	ACCESSIBLEFROMVBA_API void WINAPI DoNothing();

	ACCESSIBLEFROMVBA_API int WINAPI GetNumberI(int i);

	ACCESSIBLEFROMVBA_API void WINAPI GetNumberI2(int* pi);
}

次に、ソースファイル（AccessibleFromVBA.cpp）

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


ACCESSIBLEFROMVBA_API void WINAPI DoNothing()
{
	return;
}

//int型の値を受け取って、int型の復帰値を返す（VBAのファンクションプロシージャ相当）
ACCESSIBLEFROMVBA_API int WINAPI GetNumberI(int i)
{
	return i * 2;
}

//int型の値を受け取って、内部で値を変更して返す（VBAでパラメータをByRef で受け渡しするイメージ）
ACCESSIBLEFROMVBA_API void WINAPI GetNumberI2(int* pi)
{
	*pi *= 300;

	return;
}

最後に、モジュール定義ファイル（AccessibleFromVBA.def）

LIBRARY AccessibleFromVba

EXPORTS
	DoNothing
	GetNumberI
	GetNumberI2

全て追加したら、プロジェクトをビルドします。

========== ビルド: 1 正常終了、0 失敗、0 更新不要、0 スキップ ==========

と表示されればOK。

呼び出すExcel側は、

Private Declare Function GetNumberI Lib "C:\Datas\MyDatas\Developer\VisualStudioComunity2017\DllForVBA\ForTest\AccessibleFromVBA.dll" (ByVal l As Long) As Long

Private Declare Sub GetNumberI2 Lib "C:\Datas\MyDatas\Developer\VisualStudioComunity2017\DllForVBA\ForTest\AccessibleFromVBA.dll" (ByRef l As Long)

呼び出してみる

Public Sub DllCallTest2()

    Dim lValue  As Long
    Dim lResult As Long

    lValue = 1000

    lResult = GetNumberI(lValue)

    Debug.Print "GetNumberI:", lValue, lResult

    Debug.Print ""

    Debug.Print "GetNumberI2(Before):", lValue

    Call GetNumberI2(lValue)

    Debug.Print "GetNumberI2(After ):", lValue

End Sub

実行結果は、

call DllCallTest2
GetNumberI: 1000 2000

GetNumberI2(Before): 1000
GetNumberI2(After ): 300000

当てにならない次回予告

とりあえず、数値の受け渡しは出来たので、次は、

• 文字列
• 配列
• 構造体

の受け渡しあたりをまとめられたらいいなぁ～