add global cache
This commit is contained in:
58
src/module/GlobalCache.bas
Normal file
58
src/module/GlobalCache.bas
Normal 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
|
||||
@@ -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
|
||||
|
||||
|
||||
@@ -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
|
||||
Exit Sub
|
||||
End If
|
||||
Next
|
||||
' 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)
|
||||
|
||||
Call ClearRowData(ws, rowNum)
|
||||
' 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
|
||||
|
||||
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
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
Binary file not shown.
Reference in New Issue
Block a user