cache refactor

2026-04-22 19:43:18 +09:00
parent 1056cb1d1b
commit 1c200c6820
17 changed files with 526 additions and 607 deletions
--- a/src/module/Common_Button.bas
+++ b/src/module/Common_Button.bas
@@ -31,7 +31,25 @@ Sub Fit_Button()
 End Sub

 Sub RefreshCache_Button()
-    Dim result As Boolean: result = RefreshCache()
+    Dim cacheSheets As Variant: cacheSheets = Array("M1", "M2", "Z1", "Z2", "Z3", "Z4", "T1", "T2", "T3", "O1","O2")
+
+    Dim sheetName As Variant
+    Dim ws As Worksheet
+    For Each sheetName In cacheSheets
+        If ProcedureExists(sheetName, "Validate") Then
+            Dim errorCount As Long
+            On Error Resume Next
+            Set ws = ThisWorkbook.Worksheets(CStr(sheetName))
+            On Error GoTo 0
+            Dim isValid As Boolean: isValid = RunValidationSilent(ws, errorCount)
+            If isValid = False Then
+                MsgBox "Can't refresh " & sheetName & " cache. Validation error occurs."
+                Exit Sub
+            End If
+        End If
+    Next sheetName
+
+    Dim result As Boolean: result = RefreshAllCache()
    If result = True Then
        MsgBox "master data reload successfully."
    End If
@@ -79,6 +97,11 @@ Private Sub DO_CSV_Import(ws As Excel.Worksheet)
        writeRow = writeRow + 1
    Next i

+    ' === Step 5: Trigger sheet-specific import handler ===
+    If ProcedureExists(ws.CodeName, "ImportCSVAndTriggerChange") Then
+        Call Application.Run(ws.CodeName & ".ImportCSVAndTriggerChange", ws, writeRow)
+    End If
+
    MsgBox writeRow - cfg("StartRow") & " rows imported.", vbInformation
    GoTo FinallyExit

@@ -94,13 +117,7 @@ End Sub
 Private Sub Do_Validation(ws As Excel.Worksheet)
    On Error GoTo ErrorHandler

-    Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
-    Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName)
-
    ' step1. confirm Validate Sub
-    Dim validate As String
-    validate = ws.CodeName & ".Validate"
-    
    If Not ProcedureExists(ws.CodeName, "Validate") Then
        MsgBox "worksheet """ & ws.name & """ unimplement methods", vbExclamation
        Exit Sub
@@ -116,11 +133,7 @@ Private Sub Do_Validation(ws As Excel.Worksheet)
    ElseIf errorCount > 0 Then
        MsgBox "Validation complete. Errors: " & errorCount, vbInformation
    Else
-        'There is no error
-        Dim cacheMethodName As String: cacheMethodName = Trim(sheetConf("RefreshCacheName"))
-        If cacheMethodName <> "" Then
-            Application.Run cacheMethodName
-        End If
+        RefreshCache(ws.CodeName)
        MsgBox "Validation complete. Errors: 0", vbInformation
    End If

@@ -208,7 +221,30 @@ ExportError:
 End Sub

 Private Sub Do_Sort(ws As Excel.Worksheet)
-    '
+    On Error GoTo ErrorHandler
+
+    Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
+    Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName)
+
+    Dim startCol As String: startCol = sheetConf("StartCol")
+    Dim endCol As String: endCol = sheetConf("EndCol")
+    Dim startRow As Long: startRow = sheetConf("StartRow")
+    Dim lastDataRow As Long: lastDataRow = GetLastDataRowInRange(ws)
+
+    If lastDataRow < startRow Then
+        MsgBox "No data to sort.", vbExclamation
+        Exit Sub
+    End If
+
+    Dim sortRange As Range: Set sortRange = ws.Range(ws.Cells(startRow, ws.Range(startCol & "1").Column), ws.Cells(lastDataRow, ws.Range(endCol & "1").Column))
+    sortRange.Select
+
+    ' Show sort dialog
+    Application.Dialogs(xlDialogSort).Show
+    Exit Sub
+
+ErrorHandler:
+    MsgBox "Error: " & Err.Description, vbCritical
 End Sub

 Private Sub Do_Filter(ws As Excel.Worksheet)
@@ -253,7 +289,7 @@ ErrorHandler:
 End Sub

 ' RunValidationSilent
-private Function RunValidationSilent(ws As Worksheet, Optional ByRef errorCountOut As Long = 0) As Boolean
+Public Function RunValidationSilent(ws As Worksheet, Optional ByRef errorCountOut As Long = 0) As Boolean
    On Error GoTo ErrorHandler

    Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
@@ -296,12 +332,18 @@ ErrorHandler:
    RunValidationSilent = False
 End Function

-Private Function ProcedureExists(moduleName As String, procName As String) As Boolean
+Public Function ProcedureExists(ByVal moduleName As String, ByVal procName As String) As Boolean
    Dim VBProj As Object, VBComp As Object, CodeMod As Object
+
+    On Error Resume Next
+
    Set VBProj = ThisWorkbook.VBProject
    Set VBComp = VBProj.VBComponents(moduleName)
    If Not VBComp Is Nothing Then
        Set CodeMod = VBComp.CodeModule
        ProcedureExists = (CodeMod.ProcStartLine(procName, 0) > 0)
    End If
+
+    If Err.Number <> 0 Then ProcedureExists = False
+    On Error GoTo 0
 End Function
--- a/src/module/Common_Functions.bas
+++ b/src/module/Common_Functions.bas
@@ -69,36 +69,61 @@ Function GetLastDataRow(ByVal ws As Worksheet, ByVal columnNum As Long) As Long
    GetLastDataRow = ws.Cells(ws.Rows.Count, columnNum).End(xlUp).Row
 End Function

+Function Contains(ByVal arr As Variant, ByVal value As String) As Boolean
+    Dim i As Long
+    For i = 0 To UBound(arr)
+        If arr(i) = value Then
+            Contains = True
+            Exit Function
+        End If
+    Next i
+
+    Contains = False
+End Function
+
 ' @return dict : key = keyCol，value = Array
 ' @param sheetName
 ' @param keyCol    
 ' @param valueCols     Array(4,5,6)
 ' @param startRow      default is 7
-Function LoadLookup( _
-    ByVal sheetName As String, _
-    ByVal keyCol As Long, _
-    ByVal valueCols As Variant, _
-    Optional ByVal startRow As Long = 7 _
-) As Object
-    
+Function LoadLookup(ByVal sheetName As String, ByVal cacheName As String) As Object
+    On Error GoTo ErrHandler
+
    ' --- validate ---
-    If Trim(sheetName) = "" Then Exit Function
-    If Not IsArray(valueCols) Then
-        valueCols = Array(valueCols)
+    If Trim(sheetName) = "" Then Err.Raise 0001, "LoadLookup", "Sheet name cannot be empty."
+
+    Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
+    If Not sheetConfDict.Exists(sheetName) Then
+        Err.Raise 1004, "LoadLookup", "Sheet not configured: " & sheetName
    End If
-    Dim nValCols As Long: nValCols = UBound(valueCols) - LBound(valueCols) + 1
-    If nValCols = 0 Then Exit Function
    
    ' --- obtain worksheet ---
    On Error Resume Next
    Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets(sheetName)
-    On Error GoTo 0
-    If ws Is Nothing Then Exit Function
-    
-    ' --- obtain data（based on keyCol）---
-    Dim lastRow As Long: lastRow = ws.Cells(ws.Rows.Count, keyCol).End(xlUp).Row
-    If lastRow < startRow Then Exit Function
+    If ws Is Nothing Then Err.Raise 0003, "LoadLookup", "Worksheet named '" & sheetName & "' not found."
+    On Error GoTo ErrHandler
+
+    Dim sheetConf As Object: Set sheetConf = sheetConfDict(cacheName)
+    Dim startRow As Long: startRow = sheetConf("StartRow")
+    Dim keyCol As Long: keyCol = sheetConf("KeyCol")
+    Dim valueCols As Variant: valueCols = sheetConf("ValueCols")
+
+    Dim lastRow As Long
+    If sheetName <> cacheName Then
+        lastRow = ws.Cells(ws.Rows.Count, keyCol).End(xlUp).Row
+    Else
+        lastRow = GetLastDataRowInRange(ws)
+    End If
    
+    Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
+    If lastRow < startRow Then 
+        Set LoadLookup = dict
+        Exit Function
+    End If
+
+    Dim nValCols As Long: nValCols = UBound(valueCols) - LBound(valueCols) + 1
+    If nValCols = 0 Then Err.Raise 0002, "LoadLookup", "Value columns parameter is invalid."
+
    ' --- prepare col ---
    Dim minCol As Long: minCol = keyCol
    Dim maxCol As Long: maxCol = keyCol
@@ -133,7 +158,6 @@ Function LoadLookup( _
    Next i
    
    ' --- write into  ---
-    Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
    dict.CompareMode = vbTextCompare
    
    Dim r As Long
@@ -150,6 +174,10 @@ Function LoadLookup( _
    Next r
    
    Set LoadLookup = dict
+    Exit Function
+
+ErrHandler:
+    Err.Raise Err.Number, Err.Source, Err.Description
 End Function

 ' obtain
@@ -205,7 +233,6 @@ Sub ClearDataRows(ByVal ws As Worksheet)

    Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName)

-    '
    Dim startRow As Long: startRow = sheetConf("StartRow")
    Dim startCol As String: startCol = sheetConf("StartCol")
    Dim endCol As String: endCol = sheetConf("EndCol")
@@ -320,8 +347,27 @@ Public Function FormatDateInput(ByVal inputStr As String) As String
    End If
 End Function

+Function CheckHeaderEdit(ByVal ws As Worksheet, ByVal Target As Range) As Boolean
+    Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
+    Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName)
+    Dim headerRow As Long: headerRow = sheetConf("HeaderRow")
+
+    ' Check header row (headerRow) cannot be edited
+    If Target.Row = headerRow Then
+        Application.EnableEvents = False
+        MsgBox "Header row can not be edit", vbExclamation
+        Application.Undo
+        Application.EnableEvents = True
+
+        CheckHeaderEdit = True
+        Exit Function
+    End If
+
+    CheckHeaderEdit = False
+End Function
+
 Function GetErrorMsg(ByVal errorCode As String, Optional ByVal param0 As String = "", Optional ByVal param1 As String = "") As String
-    Dim errorList As Object: Set errorList = GetErrorList()
+    Dim errorList As Object: Set errorList = GetCache("errorList")
    Dim errorMessage As String
    If errorList.Exists(errorCode) Then
        errorMessage = Replace(errorList(errorCode)(0), "{0}", param0)
--- a/src/module/Common_Global_Cache.bas
+++ b/src/module/Common_Global_Cache.bas
--- a/src/module/Common_Selector.bas
+++ b/src/module/Common_Selector.bas
@@ -17,7 +17,7 @@ Option Explicit

 ' Create transport (T) dropdown from Z1 cache
 Public Function BuildTransportList()
-    Dim z1Cache As Object: Set z1Cache = GetZ1Cache()
+    Dim z1Cache As Object: Set z1Cache = GetCache("Z1")

    Dim dropdownList As String
    Dim key As Variant
@@ -36,7 +36,7 @@ End Function

 ' Create todoke (G) dropdown
 Public Function BuildTodokeList()
-    Dim z4Cache As Object: Set z4Cache = GetZ4Cache()
+    Dim z4Cache As Object: Set z4Cache = GetCache("Z4")

    Dim dropdownList As String
    Dim key As Variant
@@ -54,7 +54,7 @@ End Function

 ' Create oufuku (M) dropdown
 Public Function BuildOufukuList()
-    Dim oufukuList As Object: Set oufukuList = GetOufukuList()
+    Dim oufukuList As Object: Set oufukuList = GetCache("oufukuList")

    Dim dropdownList As String
    Dim key As Variant
@@ -72,7 +72,7 @@ End Function

 ' Create Koutai (N) dropdown
 Public Function BuildKoutaiList()
-    Dim koutaiList As Object: Set koutaiList = GetKoutaiList()
+    Dim koutaiList As Object: Set koutaiList = GetCache("koutaiList")

    Dim dropdownList As String
    Dim key As Variant
@@ -90,7 +90,7 @@ End Function

 ' Create Kettei (AU) dropdown
 Public Function BuildKetteiList()
-    Dim z2Cache As Object: Set z2Cache = GetZ2Cache()
+    Dim z2Cache As Object: Set z2Cache = GetCache("Z2")

    Dim dropdownList As String
    Dim key As Variant
@@ -108,7 +108,7 @@ End Function

 ' Create Higaitou (AW) dropdown
 Public Function BuildHigaitouList()
-    Dim higaitouList As Object: Set higaitouList = GetHigaitouList()
+    Dim higaitouList As Object: Set higaitouList = GetCache("higaitouList")

    Dim dropdownList As String
    Dim key As Variant
@@ -126,7 +126,7 @@ End Function

 ' Create MonthAmountKbn (AX) dropdown
 Public Function BuildMonthAmountKbnList()
-    Dim z3Cache As Object: Set z3Cache = GetZ3Cache()
+    Dim z3Cache As Object: Set z3Cache = GetCache("Z3")

    Dim dropdownList As String
    Dim key As Variant
@@ -144,7 +144,7 @@ End Function

 ' Create Kanshoku (BC) dropdown
 Public Function BuildKanshokuList()
-    Dim o2Cache As Object: Set o2Cache = GetO2Cache()
+    Dim o2Cache As Object: Set o2Cache = GetCache("O2")

    Dim dropdownList As String
    Dim key As Variant