edit C1
This commit is contained in:
updsv7
274
src/module/Global_Cache.bas
Normal file
274
src/module/Global_Cache.bas
Normal file
@@ -0,0 +1,274 @@
|
||||
' ============================================================
|
||||
' Modele Name: Global_Cache
|
||||
' Modele Desc: Global Cache Module, Shared caches across all worksheets
|
||||
' ============================================================
|
||||
|
||||
' M1 cache - used by M2_Kukan_detail, Tukin_C1
|
||||
Public m1Cache As Object
|
||||
|
||||
' M1_KukanD cache - nested dict {D: {F: [G]}}
|
||||
Public m1KukanDCache As Object
|
||||
|
||||
' Z1 cache - used by M1_Kukan
|
||||
Public z1Cache As Object
|
||||
|
||||
' Z2 cache
|
||||
Public z2Cache As Object
|
||||
|
||||
' Z3 cache
|
||||
Public z3Cache As Object
|
||||
|
||||
' O1 cache - used by Tukin_C1
|
||||
Public o1Cache As Object
|
||||
|
||||
' O2 cache
|
||||
Public o2Cache As Object
|
||||
|
||||
' M2 cache - nested dictionary for Tukin_C1
|
||||
Public m2Cache As Object
|
||||
|
||||
' ============================================================
|
||||
' M1 Cache
|
||||
' ============================================================
|
||||
Public Sub RefreshM1Cache()
|
||||
Set m1Cache = Nothing
|
||||
|
||||
On Error GoTo RefreshError
|
||||
Set m1Cache = LoadLookup("M1", keyCol:=3, valueCols:=Array(3, 4, 5, 6, 7, 9, 12), startRow:=7)
|
||||
On Error GoTo 0
|
||||
|
||||
If m1Cache Is Nothing Or m1Cache.Count = 0 Then
|
||||
Err.Raise 1001, "RefreshM1Cache", "M1 reference data is empty"
|
||||
End If
|
||||
|
||||
Exit Sub
|
||||
|
||||
RefreshError:
|
||||
Err.Raise 1002, "RefreshM1Cache", "Failed to load M1 lookup cache: " & Err.Description
|
||||
End Sub
|
||||
|
||||
Public Sub ClearM1Cache()
|
||||
Set m1Cache = Nothing
|
||||
End Sub
|
||||
|
||||
' Refresh M1_KukanD cache - nested dict {D: {F: [G]}}
|
||||
' Structure: { 交通機関区分[D]: { 利用区間発名[F]: [利用区間着名G] } }
|
||||
Public Sub RefreshM1KukanDCache()
|
||||
Set m1KukanDCache = Nothing
|
||||
Set m1KukanDCache = CreateObject("Scripting.Dictionary")
|
||||
|
||||
Dim wsM1 As Worksheet
|
||||
On Error Resume Next
|
||||
Set wsM1 = ThisWorkbook.Worksheets("M1")
|
||||
If wsM1 Is Nothing Then Exit Sub
|
||||
On Error GoTo 0
|
||||
|
||||
Dim lastRow As Long: lastRow = wsM1.Cells(wsM1.Rows.Count, 3).End(xlUp).Row
|
||||
If lastRow < 7 Then Exit Sub
|
||||
|
||||
Dim r As Long
|
||||
For r = 7 To lastRow
|
||||
Dim dValue As String: dValue = Trim(wsM1.Cells(r, 4).Value) ' D column
|
||||
Dim fValue As String: fValue = Trim(wsM1.Cells(r, 6).Value) ' F column
|
||||
Dim gValue As String: gValue = Trim(wsM1.Cells(r, 7).Value) ' G column
|
||||
|
||||
If dValue = "" Or fValue = "" Then GoTo NextRow2
|
||||
|
||||
' Outer level: D column (交通機関区分)
|
||||
If Not m1KukanDCache.Exists(dValue) Then
|
||||
Dim innerDict As Object: Set innerDict = CreateObject("Scripting.Dictionary")
|
||||
m1KukanDCache.Add dValue, innerDict
|
||||
End If
|
||||
|
||||
' Inner level: F column (利用区間発名) -> array of G values
|
||||
Set innerDict = m1KukanDCache(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
|
||||
End Sub
|
||||
|
||||
Public Sub ClearM1KukanDCache()
|
||||
Set m1KukanDCache = Nothing
|
||||
End Sub
|
||||
|
||||
' ============================================================
|
||||
' M2 Cache - Nested Dictionary
|
||||
' Structure: { 区間コード[C]: { 券種[I]: { コード[J]: K } } }
|
||||
' ============================================================
|
||||
Public Sub RefreshM2Cache()
|
||||
Set m2Cache = Nothing
|
||||
Set m2Cache = CreateObject("Scripting.Dictionary")
|
||||
|
||||
Dim wsM2 As Worksheet
|
||||
On Error Resume Next
|
||||
Set wsM2 = ThisWorkbook.Worksheets("M2")
|
||||
If wsM2 Is Nothing Then Exit Sub
|
||||
On Error GoTo 0
|
||||
|
||||
Dim lastRow As Long: lastRow = wsM2.Cells(wsM2.Rows.Count, 3).End(xlUp).Row
|
||||
If lastRow < 7 Then Exit Sub
|
||||
|
||||
Dim r As Long
|
||||
For r = 7 To lastRow
|
||||
Dim kukanCode As String: kukanCode = Trim(wsM2.Cells(r, 3).Value) ' C column
|
||||
Dim kanshu As String: kanshu = Trim(wsM2.Cells(r, 9).Value) ' I column
|
||||
Dim code As String: code = Trim(wsM2.Cells(r, 10).Value) ' J column
|
||||
Dim kValue As String: kValue = Trim(wsM2.Cells(r, 11).Value) ' K column
|
||||
|
||||
If kukanCode = "" Or kanshu = "" Or code = "" Then GoTo NextRow
|
||||
|
||||
' Outer level: kukanCode
|
||||
If Not m2Cache.Exists(kukanCode) Then
|
||||
Dim innerDict As Object: Set innerDict = CreateObject("Scripting.Dictionary")
|
||||
m2Cache.Add kukanCode, innerDict
|
||||
End If
|
||||
|
||||
' Middle level: kanshu
|
||||
Set innerDict = m2Cache(kukanCode)
|
||||
If Not innerDict.Exists(kanshu) Then
|
||||
Dim innermostDict As Object: Set innermostDict = CreateObject("Scripting.Dictionary")
|
||||
innerDict.Add kanshu, innermostDict
|
||||
End If
|
||||
|
||||
' Inner level: code -> kValue
|
||||
Set innermostDict = innerDict(kanshu)
|
||||
If Not innermostDict.Exists(code) Then
|
||||
innermostDict.Add code, kValue
|
||||
End If
|
||||
|
||||
NextRow:
|
||||
Next r
|
||||
End Sub
|
||||
|
||||
Public Sub ClearM2Cache()
|
||||
Set m2Cache = Nothing
|
||||
End Sub
|
||||
|
||||
' ============================================================
|
||||
' Z1 Cache
|
||||
' ============================================================
|
||||
Public Sub RefreshZ1Cache()
|
||||
Set z1Cache = Nothing
|
||||
|
||||
On Error GoTo RefreshError
|
||||
Set z1Cache = LoadLookup("Z1", keyCol:=3, valueCols:=Array(4), startRow:=7)
|
||||
On Error GoTo 0
|
||||
|
||||
If z1Cache Is Nothing Or z1Cache.Count = 0 Then
|
||||
Err.Raise 1001, "RefreshZ1Cache", "Z1 reference data is empty"
|
||||
End If
|
||||
|
||||
Exit Sub
|
||||
|
||||
RefreshError:
|
||||
Err.Raise 1002, "RefreshZ1Cache", "Failed to load Z1 lookup cache: " & Err.Description
|
||||
End Sub
|
||||
|
||||
Public Sub ClearZ1Cache()
|
||||
Set z1Cache = Nothing
|
||||
End Sub
|
||||
|
||||
' ============================================================
|
||||
' Z2 Cache
|
||||
' ============================================================
|
||||
Public Sub RefreshZ2Cache()
|
||||
Set z2Cache = Nothing
|
||||
|
||||
On Error GoTo RefreshError
|
||||
Set z2Cache = LoadLookup("Z2", keyCol:=3, valueCols:=Array(4), startRow:=7)
|
||||
On Error GoTo 0
|
||||
|
||||
If z2Cache Is Nothing Or z2Cache.Count = 0 Then
|
||||
Err.Raise 1001, "RefreshZ2Cache", "Z2 reference data is empty"
|
||||
End If
|
||||
|
||||
Exit Sub
|
||||
|
||||
RefreshError:
|
||||
Err.Raise 1002, "RefreshZ2Cache", "Failed to load Z2 lookup cache: " & Err.Description
|
||||
End Sub
|
||||
|
||||
Public Sub ClearZ2Cache()
|
||||
Set z2Cache = Nothing
|
||||
End Sub
|
||||
|
||||
' ============================================================
|
||||
' Z3 Cache
|
||||
' ============================================================
|
||||
Public Sub RefreshZ3Cache()
|
||||
Set z3Cache = Nothing
|
||||
|
||||
On Error GoTo RefreshError
|
||||
Set z3Cache = LoadLookup("Z3", keyCol:=3, valueCols:=Array(4), startRow:=7)
|
||||
On Error GoTo 0
|
||||
|
||||
If z3Cache Is Nothing Or z3Cache.Count = 0 Then
|
||||
Err.Raise 1001, "RefreshZ3Cache", "Z3 reference data is empty"
|
||||
End If
|
||||
|
||||
Exit Sub
|
||||
|
||||
RefreshError:
|
||||
Err.Raise 1002, "RefreshZ3Cache", "Failed to load Z3 lookup cache: " & Err.Description
|
||||
End Sub
|
||||
|
||||
Public Sub ClearZ3Cache()
|
||||
Set z3Cache = Nothing
|
||||
End Sub
|
||||
|
||||
' ============================================================
|
||||
' O1 Cache
|
||||
' ============================================================
|
||||
Public Sub RefreshO1Cache()
|
||||
Set o1Cache = Nothing
|
||||
|
||||
On Error GoTo RefreshError
|
||||
Set o1Cache = LoadLookup("O1", keyCol:=3, valueCols:=Array(5, 6), startRow:=7)
|
||||
On Error GoTo 0
|
||||
|
||||
If o1Cache Is Nothing Or o1Cache.Count = 0 Then
|
||||
Err.Raise 1001, "RefreshO1Cache", "O1 reference data is empty"
|
||||
End If
|
||||
|
||||
Exit Sub
|
||||
|
||||
RefreshError:
|
||||
Err.Raise 1002, "RefreshO1Cache", "Failed to load O1 lookup cache: " & Err.Description
|
||||
End Sub
|
||||
|
||||
Public Sub ClearO1Cache()
|
||||
Set o1Cache = Nothing
|
||||
End Sub
|
||||
|
||||
' ============================================================
|
||||
' O2 Cache
|
||||
' ============================================================
|
||||
Public Sub RefreshO2Cache()
|
||||
Set o2Cache = Nothing
|
||||
|
||||
On Error GoTo RefreshError
|
||||
Set o2Cache = LoadLookup("O2", keyCol:=3, valueCols:=Array(4), startRow:=7)
|
||||
On Error GoTo 0
|
||||
|
||||
If o2Cache Is Nothing Or o2Cache.Count = 0 Then
|
||||
Err.Raise 1001, "RefreshO2Cache", "O2 reference data is empty"
|
||||
End If
|
||||
|
||||
Exit Sub
|
||||
|
||||
RefreshError:
|
||||
Err.Raise 1002, "RefreshO2Cache", "Failed to load O2 lookup cache: " & Err.Description
|
||||
End Sub
|
||||
|
||||
Public Sub ClearO2Cache()
|
||||
Set o2Cache = Nothing
|
||||
End Sub
|
||||
Reference in New Issue
Block a user