658 lines
22 KiB
QBasic
658 lines
22 KiB
QBasic
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_O3 As String = CACHE_O3
|
|
|
|
|
|
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 = "M2" Then
|
|
Set loadedData = LookupM2Cache()
|
|
ElseIf cacheName = "O1" Then
|
|
Set loadedData = LookupO1Cache()
|
|
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
|
|
On Error Resume Next
|
|
Set ws = ThisWorkbook.Worksheets("M1")
|
|
On Error GoTo ErrHandler
|
|
' ws exists, continue
|
|
|
|
Dim sheetConf As Object: Set sheetConf = sheetConfDict("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
|
|
On Error Resume Next
|
|
Set ws = ThisWorkbook.Worksheets("M2")
|
|
On Error GoTo ErrHandler
|
|
' ws exists, continue
|
|
|
|
Dim sheetConf As Object: Set sheetConf = sheetConfDict("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
|
|
On Error Resume Next
|
|
Set ws = ThisWorkbook.Worksheets("O1")
|
|
On Error GoTo ErrHandler
|
|
' ws exists, continue
|
|
|
|
Dim sheetConf As Object: Set sheetConf = sheetConfDict("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
|
|
|
|
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") = "BC"
|
|
sheetConf("ErrorCol") = "B"
|
|
sheetConf("StartRow") = 8
|
|
sheetConf("HeaderRow") = 6
|
|
sheetConf("CSV_Encoding") = "shift_jis"
|
|
sheetConf("HasHeader") = True
|
|
sheetConf("ExpectedColumnCount") = 41
|
|
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("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("M2") = sheetConf
|
|
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("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("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("Z3") = sheetConf
|
|
Debug.Print "RefreshSheetDict Z3 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("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("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("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("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("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
|
|
Set GetSheetConfig = sheetConfDict
|
|
End Function
|
|
|
|
Public Sub RefreshMasterCache()
|
|
' Fixed cache names
|
|
Dim fixedCaches As Variant
|
|
fixedCaches = Array("Z1", "Z2", "Z3", "T1", "T2", "T3", "O1", "O2", CACHE_O3, _
|
|
"tokubetuList", "kenshuList", "renrakuList", "oufukuList", "koutaiList", "higaitouList", "errorList")
|
|
|
|
' Refresh fixed caches
|
|
Dim cacheName As Variant
|
|
For Each cacheName In fixedCaches
|
|
Call RefreshCache(CStr(cacheName))
|
|
Call WriteCachesSheet(CStr(cacheName))
|
|
Next cacheName
|
|
End Sub
|
|
|
|
Public Sub RefreshKukanCache(ByVal sheetName As String)
|
|
If sheetName = "M1" Then
|
|
Call RefreshCache("M1")
|
|
Call RefreshCache("M1KukanDCache")
|
|
Call WriteCachesSheet("M1")
|
|
End If
|
|
If sheetName = "M2" Then
|
|
Call RefreshCache("M2")
|
|
Call WriteCachesSheet("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 "Z1": colLetter = "A"
|
|
Case "Z2": colLetter = "B"
|
|
Case "Z3": colLetter = "C"
|
|
Case CACHE_O3: colLetter = "D"
|
|
Case "T1": colLetter = "E"
|
|
Case "T2": colLetter = "F"
|
|
Case "T3": colLetter = "G"
|
|
Case "O2": colLetter = "H"
|
|
Case "M1": colLetter = "I"
|
|
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
|