通勤認定エクセルツール対応12 M1 対応

2026-05-28 12:58:08 +09:00
parent df9cd0a7ad
commit 50ef0c74cc
14 changed files with 602 additions and 199 deletions
@@ -12,6 +12,7 @@ Public Const CACHE_Z1 As String = "Z1"
 Public Const CACHE_Z2 As String = "Z2"
 Public Const CACHE_Z3 As String = "Z3"
 Public Const CACHE_Z4 As String = "Z4"
+Public Const CACHE_Z4ROSEN As String = "Z4Rosen"
 Public Const CACHE_T1 As String = "T1"
 Public Const CACHE_T2 As String = "T2"
 Public Const CACHE_T3 As String = "T3"
@@ -64,8 +65,10 @@ Public Sub RefreshCache(ByVal cacheName As String)
    ElseIf cacheName = "M2" Then
        Set loadedData = LookupM2Cache()
    ElseIf cacheName = CACHE_O1 Then
-        Set loadedData = LookupO1Cache()
-    ElseIf Contains(sheetConfDict("Enum"), cacheName) Then
+            Set loadedData = LookupO1Cache()
+        ElseIf cacheName = CACHE_Z4ROSEN Then
+            Set loadedData = LookupZ4RosenCache()
+        ElseIf Contains(sheetConfDict("Enum"), cacheName) Then
        Set loadedData = LoadLookup("Enum", cacheName)
    Else
        Set loadedData = LoadLookup(cacheName, cacheName)
@@ -284,6 +287,69 @@ ErrHandler:
    End If
 End Function

+' ============================================================
+' Z4 Rosen Cache - nested dict for M1 E/F/H cascade dropdown
+' Structure: { rosen [F]: { stationFrom [D]: [stationTo E, ...] } }
+' ============================================================
+Private Function LookupZ4RosenCache() As Object
+    Dim resultCache As Object
+    Set resultCache = CreateObject("Scripting.Dictionary")
+    resultCache.CompareMode = vbTextCompare
+
+    On Error GoTo ErrHandler
+
+    Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets(CACHE_Z4)
+
+    Dim sheetConf As Object: Set sheetConf = GetSheetConfig()(CACHE_Z4)
+    Dim startRow As Long: startRow = sheetConf("StartRow")
+    Dim lastRow As Long: lastRow = GetLastDataRowInRange(ws)
+    If lastRow < startRow Then
+        Set LookupZ4RosenCache = resultCache
+        Exit Function
+    End If
+
+    Dim r As Long
+    For r = startRow To lastRow
+        Dim rosen As String: rosen = Trim(ws.Cells(r, 6).Value)
+        Dim stationFrom As String: stationFrom = Trim(ws.Cells(r, 4).Value)
+        Dim stationTo As String: stationTo = Trim(ws.Cells(r, 5).Value)
+
+        If rosen = "" Or stationFrom = "" Then GoTo NextRow3
+
+        If Not resultCache.Exists(rosen) Then
+            Dim innerDict As Object
+            Set innerDict = CreateObject("Scripting.Dictionary")
+            innerDict.CompareMode = vbTextCompare
+            resultCache.Add rosen, innerDict
+        End If
+
+        Set innerDict = resultCache(rosen)
+        If Not innerDict.Exists(stationFrom) Then
+            Dim arr As Object
+            Set arr = CreateObject("Scripting.Dictionary")
+            arr.CompareMode = vbTextCompare
+            innerDict.Add stationFrom, arr
+        End If
+
+        Set arr = innerDict(stationFrom)
+        If stationTo <> "" And Not arr.Exists(stationTo) Then
+            arr.Add stationTo, True
+        End If
+
+NextRow3:
+    Next r
+
+    Set LookupZ4RosenCache = resultCache
+    Exit Function
+
+ErrHandler:
+    If Err.Number = 9 Then
+        Err.Raise ERR_SHEET_MISSING, "LookupZ4RosenCache", "Sheet 'Z4' not found."
+    Else
+        Err.Raise ERR_CACHE_NOT_FOUND, "LookupZ4RosenCache", "Failed to load Z4Rosen cache: " & Err.Description
+    End If
+End Function
+
 Private Sub RefreshSheetDict()
    Debug.Print "RefreshSheetDict begin."
    Set sheetConfDict = CreateObject("Scripting.Dictionary")
@@ -341,58 +407,61 @@ Private Sub RefreshSheetDict()
    Debug.Print "RefreshSheetDict M2 ok."

    ' Z1
-    Set sheetConf = CreateObject("Scripting.Dictionary")
-    sheetConf("StartCol") = "C"
-    sheetConf("EndCol") = "I"
-    sheetConf("ErrorCol") = "B"
-    sheetConf("StartRow") = 7
-    sheetConf("HeaderRow") = 5
-    sheetConf("CSV_Encoding") = "utf-8"
-    sheetConf("HasHeader") = False
-    sheetConf("ExpectedColumnCount") = 7
-    sheetConf("HeaderColumns") = Array("C", "D", "E", "F", "G", "H", "I")
-    sheetConf("AlwaysQuote") = True
-    sheetConf("FilterRow") = 6
-    sheetConf("KeyCol") = 3
-    sheetConf("ValueCols") = Array(4)
-    Set sheetConfDict(CACHE_Z1) = sheetConf
-    Debug.Print "RefreshSheetDict Z1 ok."
+        Set sheetConf = CreateObject("Scripting.Dictionary")
+        sheetConf("StartCol") = "C"
+        sheetConf("EndCol") = "I"
+        sheetConf("ErrorCol") = "B"
+        sheetConf("DisplayCol") = "H"
+        sheetConf("StartRow") = 7
+        sheetConf("HeaderRow") = 5
+        sheetConf("CSV_Encoding") = "utf-8"
+        sheetConf("HasHeader") = False
+        sheetConf("ExpectedColumnCount") = 7
+        sheetConf("HeaderColumns") = Array("C", "D", "E", "F", "G", "H", "I")
+        sheetConf("AlwaysQuote") = True
+        sheetConf("FilterRow") = 6
+        sheetConf("KeyCol") = 3
+        sheetConf("ValueCols") = Array(4)
+        Set sheetConfDict(CACHE_Z1) = sheetConf
+        Debug.Print "RefreshSheetDict Z1 ok."

    ' Z2
-    Set sheetConf = CreateObject("Scripting.Dictionary")
-    sheetConf("StartCol") = "C"
-    sheetConf("EndCol") = "G"
-    sheetConf("ErrorCol") = "B"
-    sheetConf("StartRow") = 7
-    sheetConf("HeaderRow") = 5
-    sheetConf("CSV_Encoding") = "utf-8"
-    sheetConf("HasHeader") = False
-    sheetConf("ExpectedColumnCount") = 5
-    sheetConf("HeaderColumns") = Array("C", "D", "E", "F", "G")
-    sheetConf("AlwaysQuote") = True
-    sheetConf("FilterRow") = 6
-    sheetConf("KeyCol") = 3
-    sheetConf("ValueCols") = Array(4)
-    Set sheetConfDict(CACHE_Z2) = sheetConf
-    Debug.Print "RefreshSheetDict Z2 ok."
+        Set sheetConf = CreateObject("Scripting.Dictionary")
+        sheetConf("StartCol") = "C"
+        sheetConf("EndCol") = "G"
+        sheetConf("ErrorCol") = "B"
+        sheetConf("DisplayCol") = "G"
+        sheetConf("StartRow") = 7
+        sheetConf("HeaderRow") = 5
+        sheetConf("CSV_Encoding") = "utf-8"
+        sheetConf("HasHeader") = False
+        sheetConf("ExpectedColumnCount") = 5
+        sheetConf("HeaderColumns") = Array("C", "D", "E", "F", "G")
+        sheetConf("AlwaysQuote") = True
+        sheetConf("FilterRow") = 6
+        sheetConf("KeyCol") = 3
+        sheetConf("ValueCols") = Array(4)
+        Set sheetConfDict(CACHE_Z2) = sheetConf
+        Debug.Print "RefreshSheetDict Z2 ok."

    ' Z3
-    Set sheetConf = CreateObject("Scripting.Dictionary")
-    sheetConf("StartCol") = "C"
-    sheetConf("EndCol") = "H"
-    sheetConf("ErrorCol") = "B"
-    sheetConf("StartRow") = 7
-    sheetConf("HeaderRow") = 5
-    sheetConf("CSV_Encoding") = "utf-8"
-    sheetConf("HasHeader") = False
-    sheetConf("ExpectedColumnCount") = 6
-    sheetConf("HeaderColumns") = Array("C", "D", "E", "F", "G", "H")
-    sheetConf("AlwaysQuote") = True
-    sheetConf("FilterRow") = 6
-    sheetConf("KeyCol") = 3
-    sheetConf("ValueCols") = Array(4)
-    Set sheetConfDict(CACHE_Z3) = sheetConf
-    Debug.Print "RefreshSheetDict Z3 ok."
+        Set sheetConf = CreateObject("Scripting.Dictionary")
+        sheetConf("StartCol") = "C"
+        sheetConf("EndCol") = "H"
+        sheetConf("ErrorCol") = "B"
+        sheetConf("DisplayCol") = "G"
+        sheetConf("StartRow") = 7
+        sheetConf("HeaderRow") = 5
+        sheetConf("CSV_Encoding") = "utf-8"
+        sheetConf("HasHeader") = False
+        sheetConf("ExpectedColumnCount") = 6
+        sheetConf("HeaderColumns") = Array("C", "D", "E", "F", "G", "H")
+        sheetConf("AlwaysQuote") = True
+        sheetConf("FilterRow") = 6
+        sheetConf("KeyCol") = 3
+        sheetConf("ValueCols") = Array(4)
+        Set sheetConfDict(CACHE_Z3) = sheetConf
+        Debug.Print "RefreshSheetDict Z3 ok."

    ' Z4
    Set sheetConf = CreateObject("Scripting.Dictionary")
@@ -414,58 +483,61 @@ Private Sub RefreshSheetDict()
    Debug.Print "RefreshSheetDict Z4 ok."

    ' T1
-    Set sheetConf = CreateObject("Scripting.Dictionary")
-    sheetConf("StartCol") = "C"
-    sheetConf("EndCol") = "G"
-    sheetConf("ErrorCol") = "B"
-    sheetConf("StartRow") = 7
-    sheetConf("HeaderRow") = 5
-    sheetConf("CSV_Encoding") = "utf-8"
-    sheetConf("HasHeader") = False
-    sheetConf("ExpectedColumnCount") = 5
-    sheetConf("HeaderColumns") = Array("C", "D", "E", "F", "G")
-    sheetConf("AlwaysQuote") = True
-    sheetConf("FilterRow") = 6
-    sheetConf("KeyCol") = 3
-    sheetConf("ValueCols") = Array(4)
-    Set sheetConfDict(CACHE_T1) = sheetConf
-    Debug.Print "RefreshSheetDict T1 ok."
+        Set sheetConf = CreateObject("Scripting.Dictionary")
+        sheetConf("StartCol") = "C"
+        sheetConf("EndCol") = "G"
+        sheetConf("ErrorCol") = "B"
+        sheetConf("DisplayCol") = "G"
+        sheetConf("StartRow") = 7
+        sheetConf("HeaderRow") = 5
+        sheetConf("CSV_Encoding") = "utf-8"
+        sheetConf("HasHeader") = False
+        sheetConf("ExpectedColumnCount") = 5
+        sheetConf("HeaderColumns") = Array("C", "D", "E", "F", "G")
+        sheetConf("AlwaysQuote") = True
+        sheetConf("FilterRow") = 6
+        sheetConf("KeyCol") = 3
+        sheetConf("ValueCols") = Array(4)
+        Set sheetConfDict(CACHE_T1) = sheetConf
+        Debug.Print "RefreshSheetDict T1 ok."

    ' T2
-    Set sheetConf = CreateObject("Scripting.Dictionary")
-    sheetConf("StartCol") = "C"
-    sheetConf("EndCol") = "M"
-    sheetConf("ErrorCol") = "B"
-    sheetConf("StartRow") = 7
-    sheetConf("HeaderRow") = 5
-    sheetConf("CSV_Encoding") = "utf-8"
-    sheetConf("HasHeader") = False
-    sheetConf("ExpectedColumnCount") = 11
-    sheetConf("HeaderColumns") = Array("C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M")
-    sheetConf("AlwaysQuote") = True
-    sheetConf("FilterRow") = 6
-    sheetConf("KeyCol") = 3
-    sheetConf("ValueCols") = Array(4, 8, 9, 10, 11, 12, 13)
-    Set sheetConfDict(CACHE_T2) = sheetConf
-    Debug.Print "RefreshSheetDict T2 ok."
+        Set sheetConf = CreateObject("Scripting.Dictionary")
+        sheetConf("StartCol") = "C"
+        sheetConf("EndCol") = "M"
+        sheetConf("ErrorCol") = "B"
+        sheetConf("DisplayCol") = "G"
+        sheetConf("StartRow") = 7
+        sheetConf("HeaderRow") = 5
+        sheetConf("CSV_Encoding") = "utf-8"
+        sheetConf("HasHeader") = False
+        sheetConf("ExpectedColumnCount") = 11
+        sheetConf("HeaderColumns") = Array("C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M")
+        sheetConf("AlwaysQuote") = True
+        sheetConf("FilterRow") = 6
+        sheetConf("KeyCol") = 3
+        sheetConf("ValueCols") = Array(4, 8, 9, 10, 11, 12, 13)
+        Set sheetConfDict(CACHE_T2) = sheetConf
+        Debug.Print "RefreshSheetDict T2 ok."

    ' T3
-    Set sheetConf = CreateObject("Scripting.Dictionary")
-    sheetConf("StartCol") = "C"
-    sheetConf("EndCol") = "I"
-    sheetConf("ErrorCol") = "B"
-    sheetConf("StartRow") = 7
-    sheetConf("HeaderRow") = 5
-    sheetConf("CSV_Encoding") = "utf-8"
-    sheetConf("HasHeader") = False
-    sheetConf("ExpectedColumnCount") = 7
-    sheetConf("HeaderColumns") = Array("C", "D", "E", "F", "G", "H", "I")
-    sheetConf("AlwaysQuote") = True
-    sheetConf("FilterRow") = 6
-    sheetConf("KeyCol") = 3
-    sheetConf("ValueCols") = Array(4, 8, 9)
-    Set sheetConfDict(CACHE_T3) = sheetConf
-    Debug.Print "RefreshSheetDict T3 ok."
+        Set sheetConf = CreateObject("Scripting.Dictionary")
+        sheetConf("StartCol") = "C"
+        sheetConf("EndCol") = "I"
+        sheetConf("ErrorCol") = "B"
+        sheetConf("DisplayCol") = "G"
+        sheetConf("StartRow") = 7
+        sheetConf("HeaderRow") = 5
+        sheetConf("CSV_Encoding") = "utf-8"
+        sheetConf("HasHeader") = False
+        sheetConf("ExpectedColumnCount") = 7
+        sheetConf("HeaderColumns") = Array("C", "D", "E", "F", "G", "H", "I")
+        sheetConf("AlwaysQuote") = True
+        sheetConf("FilterRow") = 6
+        sheetConf("KeyCol") = 3
+        sheetConf("ValueCols") = Array(4, 8, 9)
+        Set sheetConfDict(CACHE_T3) = sheetConf
+        Debug.Print "RefreshSheetDict T3 ok."

    ' O1
    Set sheetConf = CreateObject("Scripting.Dictionary")
@@ -610,7 +682,7 @@ End Sub
 Public Sub RefreshMasterCache()
    ' Fixed cache names
    Dim fixedCaches As Variant
-    fixedCaches = Array(CACHE_Z1, CACHE_Z2, CACHE_Z3, CACHE_T1, CACHE_T2, CACHE_T3, CACHE_O1, CACHE_O2, CACHE_O3)
+    fixedCaches = Array(CACHE_Z1, CACHE_Z2, CACHE_Z3, CACHE_Z4, CACHE_Z4ROSEN, CACHE_T1, CACHE_T2, CACHE_T3, CACHE_O1, CACHE_O2, CACHE_O3)
    
    ' Refresh fixed caches
    Dim cacheName As Variant
@@ -626,6 +698,7 @@ Public Sub RefreshKukanCache(ByVal sheetName As String)
    If sheetName = "M1" Then
        Call RefreshCache("M1")
        Call RefreshCache("M1KukanDCache")
+        Call RefreshCache(CACHE_Z4ROSEN)
        Call WriteCachesSheet("M1")
    End If
    If sheetName = "M2" Then