edit C1
This commit is contained in:
updsv7
@@ -1,58 +0,0 @@
|
||||
' ============================================================
|
||||
' Modele Name: GlobalCache
|
||||
' Modele Desc: Global Cache Module, Shared caches across all worksheets
|
||||
' ============================================================
|
||||
|
||||
' M1 cache - used by M2_Kukan_detail
|
||||
Public m1Cache As Object
|
||||
|
||||
' Z1 cache - used by M1_Kukan
|
||||
Public z1Cache As Object
|
||||
|
||||
' Refresh M1 cache - called when M1 data changes
|
||||
Public Sub RefreshM1Cache()
|
||||
' Clear existing cache first to avoid memory leak
|
||||
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
|
||||
|
||||
' Clear M1 cache - called when M1 data is cleared
|
||||
Public Sub ClearM1Cache()
|
||||
Set m1Cache = Nothing
|
||||
End Sub
|
||||
|
||||
' Refresh Z1 cache - called when Z1 data changes
|
||||
Public Sub RefreshZ1Cache()
|
||||
' Clear existing cache first to avoid memory leak
|
||||
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
|
||||
|
||||
' Clear Z1 cache - called when Z1 data is cleared
|
||||
Public Sub ClearZ1Cache()
|
||||
Set z1Cache = Nothing
|
||||
End Sub
|
||||
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
|
||||
194
src/module/Test_Cache.bas
Normal file
194
src/module/Test_Cache.bas
Normal file
@@ -0,0 +1,194 @@
|
||||
' ============================================================
|
||||
' Test Cache Module
|
||||
' Debug: Print cache contents to Test_Cache sheet
|
||||
' ============================================================
|
||||
|
||||
Sub Test_PrintAllCaches()
|
||||
' Refresh all caches first
|
||||
Call RefreshM1Cache
|
||||
Call RefreshM1KukanDCache
|
||||
Call RefreshM2Cache
|
||||
Call RefreshZ1Cache
|
||||
Call RefreshO1Cache
|
||||
|
||||
' Get or create Test_Cache sheet
|
||||
Dim wb As Workbook
|
||||
Set wb = ThisWorkbook
|
||||
|
||||
Dim ws As Worksheet
|
||||
On Error Resume Next
|
||||
Set ws = wb.Worksheets("Test_Cache")
|
||||
On Error GoTo 0
|
||||
|
||||
If ws Is Nothing Then
|
||||
Set ws = wb.Worksheets.Add
|
||||
ws.Name = "Test_Cache"
|
||||
End If
|
||||
|
||||
ws.Cells.Clear
|
||||
|
||||
Dim row As Long
|
||||
row = 1
|
||||
|
||||
' Print M1 Cache
|
||||
ws.Cells(row, 1).Value = "=== M1 Cache ==="
|
||||
row = row + 1
|
||||
Call PrintM1CacheToSheet(ws, row)
|
||||
|
||||
' Print M1_KukanD Cache
|
||||
row = row + 1
|
||||
ws.Cells(row, 1).Value = "=== M1_KukanD Cache ==="
|
||||
row = row + 1
|
||||
Call PrintM1KukanDCacheToSheet(ws, row)
|
||||
|
||||
' Print M2 Cache
|
||||
row = row + 1
|
||||
ws.Cells(row, 1).Value = "=== M2 Cache ==="
|
||||
row = row + 1
|
||||
Call PrintM2CacheToSheet(ws, row)
|
||||
|
||||
' Print Z1 Cache
|
||||
row = row + 1
|
||||
ws.Cells(row, 1).Value = "=== Z1 Cache ==="
|
||||
row = row + 1
|
||||
Call PrintZ1CacheToSheet(ws, row)
|
||||
|
||||
' Print O1 Cache
|
||||
row = row + 1
|
||||
ws.Cells(row, 1).Value = "=== O1 Cache ==="
|
||||
row = row + 1
|
||||
Call PrintO1CacheToSheet(ws, row)
|
||||
|
||||
ws.Columns.AutoFit
|
||||
End Sub
|
||||
|
||||
Private Sub PrintM1CacheToSheet(ws As Worksheet, ByRef row As Long)
|
||||
If m1Cache Is Nothing Then
|
||||
ws.Cells(row, 1).Value = "m1Cache is Nothing"
|
||||
row = row + 1
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
ws.Cells(row, 1).Value = "Count: " & m1Cache.Count
|
||||
row = row + 1
|
||||
|
||||
Dim key As Variant
|
||||
For Each key In m1Cache.Keys
|
||||
Dim vals As Variant
|
||||
vals = m1Cache(key)
|
||||
ws.Cells(row, 1).Value = key
|
||||
ws.Cells(row, 2).Value = vals(1) & ": " & vals(2)
|
||||
ws.Cells(row, 3).Value = vals(3)
|
||||
ws.Cells(row, 4).Value = vals(4)
|
||||
ws.Cells(row, 5).Value = vals(5)
|
||||
row = row + 1
|
||||
Next key
|
||||
End Sub
|
||||
|
||||
Private Sub PrintM1KukanDCacheToSheet(ws As Worksheet, ByRef row As Long)
|
||||
If m1KukanDCache Is Nothing Then
|
||||
ws.Cells(row, 1).Value = "m1KukanDCache is Nothing"
|
||||
row = row + 1
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
ws.Cells(row, 1).Value = "Count: " & m1KukanDCache.Count
|
||||
row = row + 1
|
||||
|
||||
Dim dKey As Variant
|
||||
For Each dKey In m1KukanDCache.Keys
|
||||
ws.Cells(row, 1).Value = "D: " & dKey
|
||||
row = row + 1
|
||||
|
||||
Dim innerDict As Object
|
||||
Set innerDict = m1KukanDCache(dKey)
|
||||
Dim fKey As Variant
|
||||
For Each fKey In innerDict.Keys
|
||||
ws.Cells(row, 2).Value = "F: " & fKey
|
||||
row = row + 1
|
||||
|
||||
Dim arr As Object
|
||||
Set arr = innerDict(fKey)
|
||||
Dim gKey As Variant
|
||||
For Each gKey In arr.Keys
|
||||
ws.Cells(row, 3).Value = "G: " & gKey
|
||||
row = row + 1
|
||||
Next gKey
|
||||
Next fKey
|
||||
Next dKey
|
||||
End Sub
|
||||
|
||||
Private Sub PrintM2CacheToSheet(ws As Worksheet, ByRef row As Long)
|
||||
If m2Cache Is Nothing Then
|
||||
ws.Cells(row, 1).Value = "m2Cache is Nothing"
|
||||
row = row + 1
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
ws.Cells(row, 1).Value = "Count: " & m2Cache.Count
|
||||
row = row + 1
|
||||
|
||||
Dim kukanKey As Variant
|
||||
For Each kukanKey In m2Cache.Keys
|
||||
ws.Cells(row, 1).Value = "KukanCode: " & kukanKey
|
||||
row = row + 1
|
||||
|
||||
Dim innerDict As Object
|
||||
Set innerDict = m2Cache(kukanKey)
|
||||
Dim kanshuKey As Variant
|
||||
For Each kanshuKey In innerDict.Keys
|
||||
ws.Cells(row, 2).Value = "Kanshu: " & kanshuKey
|
||||
row = row + 1
|
||||
|
||||
Dim innermostDict As Object
|
||||
Set innermostDict = innerDict(kanshuKey)
|
||||
Dim codeKey As Variant
|
||||
For Each codeKey In innermostDict.Keys
|
||||
ws.Cells(row, 3).Value = "Code: " & codeKey
|
||||
ws.Cells(row, 4).Value = innermostDict(codeKey)
|
||||
row = row + 1
|
||||
Next codeKey
|
||||
Next kanshuKey
|
||||
Next kukanKey
|
||||
End Sub
|
||||
|
||||
Private Sub PrintZ1CacheToSheet(ws As Worksheet, ByRef row As Long)
|
||||
If z1Cache Is Nothing Then
|
||||
ws.Cells(row, 1).Value = "z1Cache is Nothing"
|
||||
row = row + 1
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
ws.Cells(row, 1).Value = "Count: " & z1Cache.Count
|
||||
row = row + 1
|
||||
|
||||
Dim key As Variant
|
||||
For Each key In z1Cache.Keys
|
||||
Dim vals As Variant
|
||||
vals = z1Cache(key)
|
||||
ws.Cells(row, 1).Value = key
|
||||
ws.Cells(row, 2).Value = vals(0)
|
||||
row = row + 1
|
||||
Next key
|
||||
End Sub
|
||||
|
||||
Private Sub PrintO1CacheToSheet(ws As Worksheet, ByRef row As Long)
|
||||
If o1Cache Is Nothing Then
|
||||
ws.Cells(row, 1).Value = "o1Cache is Nothing"
|
||||
row = row + 1
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
ws.Cells(row, 1).Value = "Count: " & o1Cache.Count
|
||||
row = row + 1
|
||||
|
||||
Dim key As Variant
|
||||
For Each key In o1Cache.Keys
|
||||
Dim vals As Variant
|
||||
vals = o1Cache(key)
|
||||
ws.Cells(row, 1).Value = key
|
||||
ws.Cells(row, 2).Value = vals(0)
|
||||
ws.Cells(row, 3).Value = vals(1)
|
||||
row = row + 1
|
||||
Next key
|
||||
End Sub
|
||||
Reference in New Issue
Block a user