311 lines
9.4 KiB
QBasic
311 lines
9.4 KiB
QBasic
' ============================================================
|
|
' Module Name: Global_Cache
|
|
' Module Desc: Global Cache Module, Shared caches across all worksheets
|
|
' Module Methods:
|
|
' - RefreshM1Cache / ClearM1Cache
|
|
' - RefreshM1KukanDCache / ClearM1KukanDCache
|
|
' - RefreshM2Cache / ClearM2Cache
|
|
' - RefreshZ1Cache / ClearZ1Cache
|
|
' - RefreshZ2Cache / ClearZ2Cache
|
|
' - RefreshZ3Cache / ClearZ3Cache
|
|
' - RefreshO1Cache / ClearO1Cache
|
|
' - RefreshO2Cache / ClearO2Cache
|
|
' ============================================================
|
|
|
|
' Cache Variables
|
|
Public m1Cache As Object
|
|
Public m1KukanDCache As Object
|
|
Public z1Cache As Object
|
|
Public z2Cache As Object
|
|
Public z3Cache As Object
|
|
Public o1Cache As Object
|
|
Public o2Cache As Object
|
|
Public m2Cache As Object
|
|
|
|
' m1Cache - used by M2_Kukan_detail, Tukin_C1
|
|
' m1KukanDCache - nested dict {D: {F: [G]}}
|
|
' z1Cache - used by M1_Kukan, Tukin_C1
|
|
' z2Cache
|
|
' z3Cache
|
|
' o1Cache - used by Tukin_C1
|
|
' o2Cache
|
|
' m2Cache - nested dictionary for Tukin_C1
|
|
|
|
' ============================================================
|
|
' M1 Cache - { 区間コード[C]: [value1-7] }
|
|
' ============================================================
|
|
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 name As String: name = 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 -> name
|
|
Set innermostDict = innerDict(kanshu)
|
|
If Not innermostDict.Exists(code) Then
|
|
innermostDict.Add code, name
|
|
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
|
|
Set o1Cache = CreateObject("Scripting.Dictionary")
|
|
|
|
Dim wsO1 As Worksheet
|
|
On Error Resume Next
|
|
Set wsO1 = ThisWorkbook.Worksheets("O1")
|
|
If wsO1 Is Nothing Then Exit Sub
|
|
On Error GoTo 0
|
|
|
|
Dim lastRow As Long
|
|
lastRow = wsO1.Cells(wsO1.Rows.Count, 3).End(xlUp).Row
|
|
If lastRow < 7 Then Exit Sub
|
|
|
|
Dim r As Long
|
|
For r = 7 To lastRow
|
|
Dim cVal As String
|
|
cVal = Trim(wsO1.Cells(r, 3).Value) ' C column
|
|
Dim eVal As String
|
|
eVal = Trim(wsO1.Cells(r, 5).Value) ' E column
|
|
Dim fVal As String
|
|
fVal = Trim(wsO1.Cells(r, 6).Value) ' F column
|
|
|
|
If cVal = "" Or eVal = "" Then GoTo NextO1
|
|
|
|
' Outer: C column
|
|
If Not o1Cache.Exists(cVal) Then
|
|
Dim innerDict As Object
|
|
Set innerDict = CreateObject("Scripting.Dictionary")
|
|
o1Cache.Add cVal, innerDict
|
|
End If
|
|
|
|
' Inner: E column -> array of F values
|
|
Set innerDict = o1Cache(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 fVal <> "" And Not arr.Exists(fVal) Then
|
|
arr.Add fVal, True
|
|
End If
|
|
|
|
NextO1:
|
|
Next r
|
|
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
|