Attribute VB_Name = "Common_Global_Cache" Option Explicit ' ============================================================ ' Module Name: Global_Cache ' Module Desc: Global Cache Module, Shared caches across all worksheets ' Module Methods: ' - RefreshM1KukanDCache ' - RefreshM2Cache ' - RefreshO1Cache ' ============================================================ 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" Public Const CACHE_O1 As String = "O1" Public Const CACHE_O2 As String = "O2" Public Const CACHE_O3 As String = "O3" Public Const CACHE_M1 As String = "M1" Public Const CACHE_M2 As String = "M2" Private sheetConfDict As Object Private FormulaCache As Object Public GlobalCache As Object Public Sub InitCacheManager() If GlobalCache Is Nothing Then Set GlobalCache = CreateObject("Scripting.Dictionary") GlobalCache.CompareMode = vbTextCompare End If End Sub Public Function GetCache(ByVal cacheName As String) As Object If GlobalCache Is Nothing Then InitCacheManager If Not GlobalCache.Exists(cacheName) Then Set GlobalCache(cacheName) = CreateObject("Scripting.Dictionary") GlobalCache(cacheName).CompareMode = vbTextCompare End If Dim cache As Object Set cache = GlobalCache(cacheName) If cache.Count = 0 Then Err.Raise ERR_CACHE_NOT_FOUND, "GetCache", "No cached data found for '" & cacheName & "'. Please load the cache first." End If Set GetCache = cache Exit Function End Function ' before RefreshCache, should validate Public Sub RefreshCache(ByVal cacheName As String) If GlobalCache Is Nothing Then InitCacheManager If Not GlobalCache.Exists(cacheName) Then Set GlobalCache(cacheName) = CreateObject("Scripting.Dictionary") GlobalCache(cacheName).CompareMode = vbTextCompare End If Dim loadedData As Object Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig() If cacheName = "M1KukanDCache" Then Set loadedData = LookupM1KukanCache() ElseIf cacheName = CACHE_M2 Then Set loadedData = LookupM2Cache() ElseIf cacheName = CACHE_O1 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) End If If Not loadedData Is Nothing Then Set GlobalCache(cacheName) = loadedData End If End Sub ' Refresh M1_KukanD cache - nested dict {D: {F: [G]}} ' Structure: { Transport type [D]: { Station from [F]: [Station to G] } } Private Function LookupM1KukanCache() Dim resultCache As Object Set resultCache = CreateObject("Scripting.Dictionary") On Error GoTo ErrHandler Dim ws As Worksheet Set ws = ThisWorkbook.Worksheets(CACHE_M1) Dim sheetConf As Object: Set sheetConf = sheetConfDict(CACHE_M1) Dim startRow As Long: startRow = sheetConf("StartRow") Dim lastRow As Long: lastRow = GetLastDataRowInRange(ws) If lastRow < startRow Then Set LookupM1KukanCache = resultCache Exit Function End If Dim r As Long For r = startRow To lastRow Dim dValue As String: dValue = Trim(ws.Cells(r, 4).Value) ' D column Dim fValue As String: fValue = Trim(ws.Cells(r, 6).Value) ' F column Dim gValue As String: gValue = Trim(ws.Cells(r, 7).Value) ' G column If dValue = "" Or fValue = "" Then GoTo NextRow2 ' D column (transport type) If Not resultCache.Exists(dValue) Then Dim innerDict As Object: Set innerDict = CreateObject("Scripting.Dictionary") resultCache.Add dValue, innerDict End If ' F column (station from) -> array of G values Set innerDict = resultCache(dValue) If Not innerDict.Exists(fValue) Then Dim arr As Object: Set arr = CreateObject("Scripting.Dictionary") innerDict.Add fValue, arr End If Set arr = innerDict(fValue) If gValue <> "" And Not arr.Exists(gValue) Then arr.Add gValue, True End If NextRow2: Next r Set LookupM1KukanCache = resultCache Exit Function ErrHandler: If Err.Number = 9 Then ' Subscript out of range (sheet not found) Err.Raise ERR_SHEET_MISSING, "LookupM1KukanCache", "Sheet 'M1' not found." Else Err.Raise ERR_CACHE_NOT_FOUND, "LookupM1KukanCache", "Failed to load M1Kukan cache: " & Err.Description End If End Function ' ============================================================ ' M2 Cache - Nested Dictionary ' Structure: { Section code [C]: { Ticket type [I]: { Code [J]: K } } } ' ============================================================ Private Function LookupM2Cache() As Object Dim resultCache As Object Set resultCache = CreateObject("Scripting.Dictionary") On Error GoTo ErrHandler Dim ws As Worksheet Set ws = ThisWorkbook.Worksheets(CACHE_M2) Dim sheetConf As Object: Set sheetConf = sheetConfDict(CACHE_M2) Dim startRow As Long: startRow = sheetConf("StartRow") Dim lastRow As Long: lastRow = GetLastDataRowInRange(ws) If lastRow < startRow Then Set LookupM2Cache = resultCache Exit Function End If Dim r As Long For r = startRow To lastRow Dim kukanCode As String: kukanCode = Trim(ws.Cells(r, 3).Value) ' C column Dim kenshu As String: kenshu = Trim(ws.Cells(r, 9).Value) ' I column Dim code As String: code = Trim(ws.Cells(r, 10).Value) ' J column Dim name As String: name = Trim(ws.Cells(r, 11).Value) ' K column Dim teikikikanNum As String: teikikikanNum = Trim(ws.Cells(r, 14).Value) ' N column If kukanCode = "" Or kenshu = "" Or code = "" Then GoTo NextRow ' Outer level: kukanCode If Not resultCache.Exists(kukanCode) Then Dim innerDict As Object: Set innerDict = CreateObject("Scripting.Dictionary") resultCache.Add kukanCode, innerDict End If ' Middle level: kenshu Set innerDict = resultCache(kukanCode) If Not innerDict.Exists(kenshu) Then Dim innermostDict As Object: Set innermostDict = CreateObject("Scripting.Dictionary") innerDict.Add kenshu, innermostDict End If ' Inner level: code -> {name, teikikikanNumList} Set innermostDict = innerDict(kenshu) Dim infoDict As Object If Not innermostDict.Exists(code) Then Set infoDict = CreateObject("Scripting.Dictionary") infoDict.Add "name", name infoDict.Add "teikikikanNum", Array(teikikikanNum) innermostDict.Add code, infoDict Else ' Already exists, add teikikikanNum to the list Set infoDict = innermostDict(code) Dim oldList As Variant: oldList = infoDict("teikikikanNum") ReDim Preserve oldList(UBound(oldList) + 1) oldList(UBound(oldList)) = teikikikanNum infoDict("teikikikanNum") = oldList End If NextRow: Next r Set LookupM2Cache = resultCache Exit Function ErrHandler: If Err.Number = 9 Then Err.Raise ERR_SHEET_MISSING, "LookupM2Cache", "Sheet 'M2' not found." Else Err.Raise ERR_CACHE_NOT_FOUND, "LookupM2Cache", "Failed to load M2 cache: " & Err.Description End If End Function ' ============================================================ ' O1 Cache ' ============================================================ Private Function LookupO1Cache() As Object Dim resultCache As Object Set resultCache = CreateObject("Scripting.Dictionary") On Error GoTo ErrHandler Dim ws As Worksheet Set ws = ThisWorkbook.Worksheets(CACHE_O1) Dim sheetConf As Object: Set sheetConf = sheetConfDict(CACHE_O1) Dim startRow As Long: startRow = sheetConf("StartRow") Dim lastRow As Long: lastRow = GetLastDataRowInRange(ws) If lastRow < startRow Then Set LookupO1Cache = resultCache Exit Function End If Dim r As Long For r = startRow To lastRow Dim cVal As String cVal = Trim(ws.Cells(r, 3).Value) ' C column Dim eVal As String eVal = Trim(ws.Cells(r, 5).Value) ' E column Dim fVal As String fVal = Trim(ws.Cells(r, 6).Value) ' F column If cVal = "" Or eVal = "" Then GoTo NextO1 ' Outer: C column If Not resultCache.Exists(cVal) Then Dim innerDict As Object Set innerDict = CreateObject("Scripting.Dictionary") resultCache.Add cVal, innerDict End If ' Inner: E column -> array of F values Set innerDict = resultCache(cVal) If Not innerDict.Exists(eVal) Then Dim arr As Object Set arr = CreateObject("Scripting.Dictionary") innerDict.Add eVal, arr End If Set arr = innerDict(eVal) If Not arr.Exists(fVal) Then arr.Add fVal, True End If NextO1: Next r Set LookupO1Cache = resultCache Exit Function ErrHandler: If Err.Number = 9 Then Err.Raise ERR_SHEET_MISSING, "LookupO1Cache", "Sheet 'O1' not found." Else Err.Raise ERR_CACHE_NOT_FOUND, "LookupO1Cache", "Failed to load O1 cache: " & Err.Description End If End Function ' ============================================================ ' Z4 Rosen Cache - nested dict for M1 E/F/H cascade dropdown ' Structure: { rosen [F]: { station [D]: True } } ' ============================================================ 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 Dim station As String Dim rosen As String Dim innerDict As Object For r = startRow To lastRow rosen = Trim(ws.Cells(r, 6).Value) station = Trim(ws.Cells(r, 4).Value) If rosen = "" Or station = "" Then GoTo NextRow3 If Not resultCache.Exists(rosen) Then Set innerDict = CreateObject("Scripting.Dictionary") innerDict.CompareMode = vbTextCompare resultCache.Add rosen, innerDict End If Set innerDict = resultCache(rosen) If Not innerDict.Exists(station) Then innerDict.Add station, 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") Dim sheetConf As Object ' C1 Set sheetConf = CreateObject("Scripting.Dictionary") sheetConf("StartCol") = "C" sheetConf("EndCol") = "BG" sheetConf("ErrorCol") = "B" sheetConf("StartRow") = 8 sheetConf("HeaderRow") = 6 sheetConf("CSV_Encoding") = "shift_jis" sheetConf("HasHeader") = True sheetConf("ExpectedColumnCount") = 45 sheetConf("HeaderColumns") = Array("C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "W", "X", "Y", "Z", "AA", "AE", "AF", "AG", "AH", "AI", "AM", "AN", "AO", "AP", "AQ", "AU", "AV", "AW", "AX", "AY", "AZ", "BA", "BB", "BC", "BD", "BE", "BF", "BG") sheetConf("AlwaysQuote") = False sheetConf("FilterRow") = 7 Set sheetConfDict("C1") = sheetConf Debug.Print "RefreshSheetDict C1 ok." ' M1 Set sheetConf = CreateObject("Scripting.Dictionary") sheetConf("StartCol") = "C" sheetConf("EndCol") = "N" sheetConf("ErrorCol") = "B" sheetConf("StartRow") = 7 sheetConf("HeaderRow") = 5 sheetConf("CacheName") = "m1Cache" sheetConf("CSV_Encoding") = "shift_jis" sheetConf("HasHeader") = True sheetConf("ExpectedColumnCount") = 12 sheetConf("HeaderColumns") = Array("C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N") sheetConf("AlwaysQuote") = False sheetConf("FilterRow") = 6 sheetConf("KeyCol") = 3 sheetConf("ValueCols") = Array(3, 4, 5, 6, 7, 9, 12) Set sheetConfDict(CACHE_M1) = sheetConf Debug.Print "RefreshSheetDict M1 ok." ' M2 Set sheetConf = CreateObject("Scripting.Dictionary") sheetConf("StartCol") = "C" sheetConf("EndCol") = "R" sheetConf("ErrorCol") = "B" sheetConf("StartRow") = 8 sheetConf("HeaderRow") = 6 sheetConf("CSV_Encoding") = "shift_jis" sheetConf("HasHeader") = True sheetConf("ExpectedColumnCount") = 11 sheetConf("HeaderColumns") = Array("C", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R") sheetConf("AlwaysQuote") = False sheetConf("FilterRow") = 7 Set sheetConfDict(CACHE_M2) = sheetConf Debug.Print "RefreshSheetDict M2 ok." ' Z1 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("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("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") sheetConf("StartCol") = "C" sheetConf("EndCol") = "H" sheetConf("ErrorCol") = "B" sheetConf("DisplayCol") = "H" 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_Z4) = sheetConf Debug.Print "RefreshSheetDict Z4 ok." ' T1 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("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) sheetConf("ZeroFillCols") = Array("H", "I", "J", "K", "L", "M") 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("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") sheetConf("StartCol") = "C" sheetConf("EndCol") = "F" sheetConf("ErrorCol") = "B" sheetConf("StartRow") = 6 sheetConf("HeaderRow") = "5" sheetConf("CSV_Encoding") = "shift_jis" sheetConf("HasHeader") = True sheetConf("ExpectedColumnCount") = 4 sheetConf("HeaderColumns") = Array("C", "D", "E", "F") sheetConf("AlwaysQuote") = True sheetConf("FilterRow") = 5 Set sheetConfDict(CACHE_O1) = sheetConf Debug.Print "RefreshSheetDict O1 ok." ' O2 Set sheetConf = CreateObject("Scripting.Dictionary") sheetConf("StartCol") = "C" sheetConf("EndCol") = "O" sheetConf("ErrorCol") = "B" sheetConf("StartRow") = 6 sheetConf("HeaderRow") = "5" sheetConf("CSV_Encoding") = "utf-8" sheetConf("HasHeader") = False sheetConf("ExpectedColumnCount") = 13 sheetConf("HeaderColumns") = Array("C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O") sheetConf("AlwaysQuote") = True sheetConf("FilterRow") = 5 sheetConf("KeyCol") = 3 sheetConf("ValueCols") = Array(4) Set sheetConfDict(CACHE_O2) = sheetConf Debug.Print "RefreshSheetDict O2 ok." ' O3 Set sheetConf = CreateObject("Scripting.Dictionary") sheetConf("StartCol") = "C" sheetConf("EndCol") = "I" sheetConf("ErrorCol") = "B" sheetConf("StartRow") = 6 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") = 5 sheetConf("KeyCol") = 3 sheetConf("ValueCols") = Array(4) Set sheetConfDict(CACHE_O3) = sheetConf Debug.Print "RefreshSheetDict O3 ok." ' Enum Set sheetConf = Nothing sheetConfDict("Enum") = Array("tokubetuList", "kenshuList", "renrakuList", "oufukuList", "koutaiList", "higaitouList", "errorList") Debug.Print "RefreshSheetDict Enum ok." ' tokubetuList Set sheetConf = CreateObject("Scripting.Dictionary") sheetConf("StartRow") = 3 sheetConf("KeyCol") = 1 sheetConf("ValueCols") = Array(1) Set sheetConfDict("tokubetuList") = sheetConf Debug.Print "RefreshSheetDict tokubetuList ok." ' kenshuList Set sheetConf = CreateObject("Scripting.Dictionary") sheetConf("StartRow") = 3 sheetConf("KeyCol") = 3 sheetConf("ValueCols") = Array(4) Set sheetConfDict("kenshuList") = sheetConf Debug.Print "RefreshSheetDict kenshuList ok." ' renrakuList Set sheetConf = CreateObject("Scripting.Dictionary") sheetConf("StartRow") = 3 sheetConf("KeyCol") = 6 sheetConf("ValueCols") = Array(6) Set sheetConfDict("renrakuList") = sheetConf Debug.Print "RefreshSheetDict renrakuList ok." ' oufukuList Set sheetConf = CreateObject("Scripting.Dictionary") sheetConf("StartRow") = 3 sheetConf("KeyCol") = 8 sheetConf("ValueCols") = Array(9) Set sheetConfDict("oufukuList") = sheetConf Debug.Print "RefreshSheetDict oufukuList ok." ' koutaiList Set sheetConf = CreateObject("Scripting.Dictionary") sheetConf("StartRow") = 3 sheetConf("KeyCol") = 11 sheetConf("ValueCols") = Array(12) Set sheetConfDict("koutaiList") = sheetConf Debug.Print "RefreshSheetDict koutaiList ok." ' higaitouList Set sheetConf = CreateObject("Scripting.Dictionary") sheetConf("StartRow") = 3 sheetConf("KeyCol") = 14 sheetConf("ValueCols") = Array(15) Set sheetConfDict("higaitouList") = sheetConf Debug.Print "RefreshSheetDict higaitouList ok." ' errorList Set sheetConf = CreateObject("Scripting.Dictionary") sheetConf("StartRow") = 3 sheetConf("KeyCol") = 17 sheetConf("ValueCols") = Array(18) Set sheetConfDict("errorList") = sheetConf Debug.Print "RefreshSheetDict errorList ok." ' Caches Set sheetConf = CreateObject("Scripting.Dictionary") ' TODO Set sheetConfDict("Caches") = sheetConf Debug.Print "RefreshSheetDict Caches ok." Debug.Print "RefreshSheetDict end." End Sub Public Function GetSheetConfig() As Object If sheetConfDict Is Nothing Then Call RefreshSheetDict Call RefreshEnumCache End If Set GetSheetConfig = sheetConfDict End Function Public Sub RefreshEnumCache() Dim fixedEnumCaches As Variant fixedEnumCaches = Array("tokubetuList", "kenshuList", "renrakuList", "oufukuList", "koutaiList", "higaitouList", "errorList") Dim cacheName As Variant For Each cacheName In fixedEnumCaches Call RefreshCache(CStr(cacheName)) Next cacheName End Sub Public Sub RefreshMasterCache() ' Fixed cache names Dim fixedCaches As Variant 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 For Each cacheName In fixedCaches Call RefreshCache(CStr(cacheName)) Call WriteCachesSheet(CStr(cacheName)) Next cacheName Call RefreshEnumCache End Sub Public Sub RefreshKukanCache(ByVal sheetName As String) If sheetName = CACHE_M1 Then Call RefreshCache(CACHE_M1) Call RefreshCache("M1KukanDCache") Call RefreshCache(CACHE_Z4ROSEN) Call WriteCachesSheet(CACHE_M1) End If If sheetName = CACHE_M2 Then Call RefreshCache(CACHE_M2) Call WriteCachesSheet(CACHE_M2) End If End Sub ' Write cache data to Caches sheet for dropdown Public Sub WriteCachesSheet(ByVal cacheName As String) Dim wsCache As Worksheet Set wsCache = ThisWorkbook.Sheets("Caches") If wsCache Is Nothing Then Set wsCache = ThisWorkbook.Sheets.Add wsCache.Name = "Caches" wsCache.Visible = xlVeryHidden End If ' Map cacheName to column letter Dim colLetter As String Select Case cacheName Case CACHE_Z1: colLetter = "A" Case CACHE_Z2: colLetter = "B" Case CACHE_Z3: colLetter = "C" Case CACHE_Z4: colLetter = "D" Case CACHE_T1: colLetter = "E" Case CACHE_T2: colLetter = "F" Case CACHE_T3: colLetter = "G" Case CACHE_O2: colLetter = "H" Case CACHE_O3: colLetter = "I" Case CACHE_M1: colLetter = "M" Case Else: Exit Sub End Select Dim cache As Object: Set cache = GetCache(cacheName) If cache Is Nothing Then Exit Sub ' Write to Caches sheet wsCache.Columns(colLetter).ClearContents Dim idx As Long: idx = 1 Dim key As Variant For Each key In cache.Keys If key <> 0 Then Dim displayText As String: displayText = MakeSelect(key, cache(key)(0)) If displayText <> "" Then wsCache.Cells(idx, colLetter).Value = displayText idx = idx + 1 End If End If Next key Dim lastRow As Long: lastRow = wsCache.Cells(wsCache.Rows.Count, colLetter).End(xlUp).Row Dim formulaStr As String If lastRow >= 1 Then formulaStr = "=Caches!" & colLetter & "1:" & colLetter & lastRow Else formulaStr = "=Caches!" & colLetter & "1" End If ' write into FormulaCache If FormulaCache Is Nothing Then Set FormulaCache = CreateObject("Scripting.Dictionary") FormulaCache(cacheName) = formulaStr End Sub Public Function GetValidationFormula(ByVal cacheName As String) As String If FormulaCache Is Nothing Then Set FormulaCache = CreateObject("Scripting.Dictionary") If FormulaCache.Exists(cacheName) Then GetValidationFormula = FormulaCache(cacheName) Else GetValidationFormula = "" End If End Function