add global cache

This commit is contained in:
updsv7
2026-04-16 16:01:47 +09:00
parent c39b8da85e
commit b0c6ec6baa
5 changed files with 111 additions and 74 deletions

View File

@@ -0,0 +1,58 @@
' ============================================================
' 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

View File

@@ -4,29 +4,13 @@ Const END_COL As Long = 14 ' N column
Const ERROR_COL As Long = 15 ' O column
Const M1_HEADER_ROW As Long = 5
Private z1Cache As Object ' Z1 cache
Private enumCache As Object ' Z1 cache
Private enumCache As Object ' Enum cache
Function HEADERS() As Variant
HEADERS = Array("C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N")
End Function
' ====== Function ======
Public Sub RefreshZ1Cache()
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 RefreshEnumCache()
On Error GoTo RefreshError
Set tokubetuKbn = LoadLookup("Enum", keyCol:=1, valueCols:=Array(1), startRow:=3)
@@ -244,6 +228,11 @@ Sub M1_validateButton()
End If
Next r
' === Refresh M1 cache after validation passes ===
If errorCount = 0 Then
Call RefreshM1Cache
End If
MsgBox "Validation complete. Errors: " & errorCount, vbInformation
End Sub

View File

@@ -4,27 +4,11 @@ Const END_COL As Long = 18 ' R column
Const ERROR_COL As Long = 19 ' S column
Const M2_HEADER_ROW As Long = 6
Private m1Cache As Object ' M1 cache
Function HEADERS() As Variant
HEADERS = Array("C", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R")
End Function
' ====== Function ======
Public Sub RefreshM1Cache()
On Error GoTo RefreshError
Set m1Cache = LoadLookup("M1", keyCol:=3, valueCols:=Array(4), 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
Private Sub Worksheet_Change(ByVal Target As Range)
' === Fill D, E when C column changes ===
@@ -34,44 +18,46 @@ Private Sub Worksheet_Change(ByVal Target As Range)
If Trim(cell.Value) = "" Then
Call ClearRowData(Me, cell.Row)
Else
Call FillFromM1(Me, cell.Row)
Call FillFromM1(cell.Row)
End If
Next
End If
End Sub
Sub FillFromM1(ByVal ws As Worksheet, ByVal rowNum As Long, Optional ByVal setG As Boolean = True)
Dim wsKukan As Worksheet
Dim lastRow As Long
Dim i As Long
Dim code As String
Sub FillFromM1(ByVal rowNum As Long, Optional ByVal setG As Boolean = True)
Set ws = Me
On Error Resume Next
Set wsKukan = ThisWorkbook.Worksheets("M1")
If wsKukan Is Nothing Then Exit Sub
On Error GoTo 0
code = Trim(ws.Cells(rowNum, 3).Value)
If code = "" Then Exit Sub
lastRow = wsKukan.Cells(wsKukan.Rows.Count, 3).End(xlUp).Row
If m1Cache Is Nothing Then Call RefreshM1Cache
Dim cValue As String: cValue = Trim(ws.Range("C" & rowNum).Value)
For i = 7 To lastRow
If Trim(wsKukan.Cells(i, 3).Value) = code Then
ws.Cells(rowNum, 4).Value = Trim(wsKukan.Cells(i, 4).Value) & ": " & Trim(wsKukan.Cells(i, 5).Value)
ws.Cells(rowNum, 5).Value = Trim(wsKukan.Cells(i, 6).Value)
ws.Cells(rowNum, 6).Value = Trim(wsKukan.Cells(i, 7).Value)
ws.Cells(rowNum, 7).Value = Trim(wsKukan.Cells(i, 9).Value)
ws.Cells(rowNum, 8).Value = Trim(wsKukan.Cells(i, 14).Value)
If setG Then
ws.Cells(rowNum, 7).Value = "1"
End If
' Fill D, E, F, G, H columns from M1 cache
' D = cache[1]: cache[2] (col 4: col 5)
' E = cache[3] (col 6)
' F = cache[4] (col 7)
' G = cache[5] (col 9)
' H = cache[6] (col 12)
' Check C column in the cache
If Not m1Cache.Exists(cValue) Then
ws.Cells(rowNum, ERROR_COL).Value = "C column does not exist in M1."
ws.Range("C" & rowNum).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
Next
Call ClearRowData(ws, rowNum)
Dim cacheVal As Variant: cacheVal = m1Cache(cValue)
' D column = cache[1]: cache[2]
ws.Cells(rowNum, 4).Value = Trim(cacheVal(1)) & ": " & Trim(cacheVal(2))
' E column = cache[3]
ws.Cells(rowNum, 5).Value = Trim(cacheVal(3))
' F column = cache[4]
ws.Cells(rowNum, 6).Value = Trim(cacheVal(4))
' G column = cache[5]
ws.Cells(rowNum, 7).Value = Trim(cacheVal(5))
' H column = cache[6]
ws.Cells(rowNum, 8).Value = Trim(cacheVal(6))
End Sub
Sub ClearRowData(ByVal ws As Worksheet, ByVal rowNum As Long)
' Clear from D column onwards
ws.Range(ws.Cells(rowNum, 4), ws.Cells(rowNum, 15)).ClearContents
@@ -127,6 +113,16 @@ Sub validate(ByVal rowNum As Long, ByVal lastDataRow As Long)
Set clearRange = ws.Range(ws.Cells(rowNum, START_COL), ws.Cells(rowNum, END_COL))
clearRange.Interior.Color = vbWhite
' Check C column in the cache
If m1Cache Is Nothing Then Call RefreshM1Cache
Dim cValue As String: cValue = Trim(ws.Range("C" & rowNum).Value)
If cValue <> "" AND Not m1Cache.Exists(cValue) Then
ws.Cells(rowNum, ERROR_COL).Value = "C column does not exist in M1."
ws.Range("C" & rowNum).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
' Check column required
Dim colLetter As Variant
For Each colLetter In Array("C", "I", "J", "K")
@@ -149,16 +145,6 @@ Sub validate(ByVal rowNum As Long, ByVal lastDataRow As Long)
End If
Next col
' Check C column in the cache
If m1Cache Is Nothing Then Call RefreshM1Cache
Dim dValue As String: dValue = Trim(ws.Range("C" & rowNum).Value)
If Not m1Cache.Exists(dValue) Then
ws.Cells(rowNum, ERROR_COL).Value = "C column does not exist in M1."
ws.Range("C" & rowNum).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
' Check I column in the kenshuKbn
Dim kenshuKbn As Variant: kenshuKbn = Array("1", "2", "3")
Dim iValue As String: iValue = Trim(ws.Range("I" & rowNum).Value)
@@ -170,7 +156,6 @@ Sub validate(ByVal rowNum As Long, ByVal lastDataRow As Long)
End Sub
' Button macro (Validate selected row)
Sub M2_validateButton()
Dim lastDataRow As Long, r As Long, errorCount As Long

View File

@@ -151,6 +151,11 @@ Sub Z1_validateButton()
End If
Next r
' === Refresh Z1 cache after validation passes ===
If errorCount = 0 Then
Call RefreshZ1Cache
End If
MsgBox "Validation complete. Errors: " & errorCount, vbInformation
End Sub