diff --git a/src/sh/tuk/module/Common_Button.bas b/src/sh/tuk/module/Common_Button.bas index 9ce0961..5ce4fe3 100644 --- a/src/sh/tuk/module/Common_Button.bas +++ b/src/sh/tuk/module/Common_Button.bas @@ -31,8 +31,22 @@ Sub Fit_Button() End Sub Sub RefreshCache_Button() - Dim cacheSheets As Variant: cacheSheets = Array("M1", "M2", "Z1", "Z2", "Z3", "Z4", "T1", "T2", "T3", "O1","O2") + Dim activeSheetName As String: activeSheetName = ActiveSheet.CodeName + + ' Determine which cache sheets to refresh based on ActiveSheet + Dim cacheSheets As Variant + If activeSheetName = "C1" Then + cacheSheets = Array("M1", "M2", "Z1", "Z2", "Z3", "Z4", "T1", "T2", "T3", "O1", "O2") + ElseIf activeSheetName = "M1" Then + cacheSheets = Array("Z1", "Z2", "Z3", "Z4", "T1", "T2", "T3", "O1", "O2") + ElseIf activeSheetName = "M2" Then + cacheSheets = Array("M1", "Z1", "Z2", "Z3", "Z4", "T1", "T2", "T3", "O1", "O2") + Else + MsgBox "This sheet does not support cache refresh.", vbExclamation + Exit Sub + End If + ' Validate and refresh cache Dim sheetName As Variant Dim ws As Worksheet For Each sheetName In cacheSheets @@ -49,8 +63,25 @@ Sub RefreshCache_Button() End If Next sheetName - Dim result As Boolean: result = RefreshAllCache() + ' Refresh cache based on activeSheet + Dim result As Boolean: result = RefreshAllCache(activeSheetName) If result = True Then + ' Call active sheet's Refresh method + If ProcedureExists(activeSheetName, "Refresh") Then + On Error Resume Next + Set ws = ActiveSheet + On Error GoTo 0 + If Not ws Is Nothing Then + Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig() + Dim sheetConf As Object: Set sheetConf = sheetConfDict(activeSheetName) + Dim startRow As Long: startRow = sheetConf("StartRow") + Dim lastDataRow As Long: lastDataRow = GetLastDataRowInRange(ws) + Application.Run activeSheetName & ".Refresh", ws, startRow, lastDataRow + End If + Else + MsgBox "Sheet " & activeSheetName & " does not implement Refresh method.", vbExclamation + End If + MsgBox "master data reload successfully." End If End Sub diff --git a/src/sh/tuk/module/Common_Global_Cache.bas b/src/sh/tuk/module/Common_Global_Cache.bas index bc32aa4..2310d70 100644 --- a/src/sh/tuk/module/Common_Global_Cache.bas +++ b/src/sh/tuk/module/Common_Global_Cache.bas @@ -573,15 +573,32 @@ Public Function GetSheetConfig() As Object Set GetSheetConfig = sheetConfDict End Function -Public Function RefreshAllCache() As Boolean - ' refresh - Dim refreshCacheNames As Variant - refreshCacheNames = Array("Z1", "Z2", "Z3", "Z4", "T1", "T2", "T3", "M1", "M1KukanDCache", "M2", "O1","O2", _ +Public Function RefreshAllCache(Optional ByVal activeSheetName As String = "") As Boolean + ' Fixed cache names + Dim fixedCaches As Variant + fixedCaches = Array("Z1", "Z2", "Z3", "Z4", "T1", "T2", "T3", "O1", "O2", _ "tokubetuList", "kenshuList", "oufukuList", "koutaiList", "higaitouList", "errorList") - Dim refreshCacheName As Variant - For Each refreshCacheName In refreshCacheNames - Call RefreshCache(refreshCacheName) - Next refreshCacheName + + ' Dynamic cache names based on activeSheet + Dim dynamicCaches As Variant + If activeSheetName = "C1" Then + dynamicCaches = Array("M1", "M1KukanDCache", "M2") + ElseIf activeSheetName = "M2" Then + dynamicCaches = Array("M1", "M1KukanDCache") + Else + dynamicCaches = Array() + End If + + ' Refresh fixed caches + Dim cacheName As Variant + For Each cacheName In fixedCaches + Call RefreshCache(CStr(cacheName)) + Next cacheName + + ' Refresh dynamic caches + For Each cacheName In dynamicCaches + Call RefreshCache(CStr(cacheName)) + Next cacheName RefreshAllCache = True End Function \ No newline at end of file diff --git a/src/sh/tuk/sheet/M1.cls b/src/sh/tuk/sheet/M1.cls index b698f90..960c3f9 100644 --- a/src/sh/tuk/sheet/M1.cls +++ b/src/sh/tuk/sheet/M1.cls @@ -165,3 +165,24 @@ Private Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As ' Validation passed - clear error ws.Cells(rowNum, errorCol).ClearContents End Sub + +' obtain z1 master data, and update column E +Private Sub Refresh(ws As Worksheet, ByVal startRow As Long, ByVal lastDataRow As Long) + Dim z1Cache As Object: Set z1Cache = GetCache("Z1") + If z1Cache Is Nothing Then Exit Sub + + Application.EnableEvents = False + On Error GoTo Finally + + Dim r As Long + For r = startRow To lastDataRow + Dim dVal As String: dVal = Trim(ws.Cells(r, 4).Value) ' Column D + If dVal <> "" And z1Cache.Exists(dVal) Then + Dim valsD As Variant: valsD = z1Cache(dVal) + ws.Cells(r, 5).Value = valsD(0) ' Column E + End If + Next r + +Finally: + Application.EnableEvents = True +End Sub \ No newline at end of file diff --git a/src/sh/tuk/sheet/M2.cls b/src/sh/tuk/sheet/M2.cls index 903fb46..5567e57 100644 --- a/src/sh/tuk/sheet/M2.cls +++ b/src/sh/tuk/sheet/M2.cls @@ -36,7 +36,7 @@ Private Sub Worksheet_Change(ByVal Target As Range) Call ClearRowData(Me, cell.Row) GoTo Finally Else - Call FillFromM1(cell.Row) + Call FillFromM1(Me, cell.Row) End If Next End If @@ -57,7 +57,7 @@ Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column = 10 Then Dim cellJ As Range For Each cellJ In Target - Call FillKFromJ(cellJ.Row) + Call FillKFromJ(Me, cellJ.Row) Next End If @@ -87,13 +87,13 @@ Finally: Application.EnableEvents = True ' End Sub -Private Sub FillKFromJ(ByVal rowNum As Long) - Dim iValue As String: iValue = Trim(Me.Range("I" & rowNum).Value) - Dim jValue As String: jValue = Trim(Me.Range("J" & rowNum).Value) +Private Sub FillKFromJ(ByVal ws As Worksheet, ByVal rowNum As Long) + Dim iValue As String: iValue = Trim(ws.Range("I" & rowNum).Value) + Dim jValue As String: jValue = Trim(ws.Range("J" & rowNum).Value) Dim code As String: code = GetCode(jValue) If jValue = "" Then - Me.Range("K" & rowNum).ClearContents + ws.Range("K" & rowNum).ClearContents Exit Sub End If @@ -116,23 +116,23 @@ Private Sub FillKFromJ(ByVal rowNum As Long) If cache.Exists(code) Then Dim cacheVal As Variant: cacheVal = cache(code) - Me.Range("J" & rowNum).Value = Trim(code) - Me.Range("K" & rowNum).Value = Trim(cacheVal(0)) + ws.Range("J" & rowNum).Value = Trim(code) + ws.Range("K" & rowNum).Value = Trim(cacheVal(0)) End If Select Case iValue Case "1" Exit Sub Case "2" - Me.Range("L" & rowNum).Value = Trim(cacheVal(2)) - Me.Range("M" & rowNum).Value = Trim(cacheVal(3)) - Me.Range("N" & rowNum).Value = Trim(cacheVal(4)) - Me.Range("O" & rowNum).Value = Trim(cacheVal(5)) - Me.Range("P" & rowNum).Value = Trim(cacheVal(6)) - Me.Range("Q" & rowNum).Value = Trim(cacheVal(7)) + ws.Range("L" & rowNum).Value = Trim(cacheVal(2)) + ws.Range("M" & rowNum).Value = Trim(cacheVal(3)) + ws.Range("N" & rowNum).Value = Trim(cacheVal(4)) + ws.Range("O" & rowNum).Value = Trim(cacheVal(5)) + ws.Range("P" & rowNum).Value = Trim(cacheVal(6)) + ws.Range("Q" & rowNum).Value = Trim(cacheVal(7)) Case "3" - Me.Range("L" & rowNum).Value = Trim(cacheVal(1)) - Me.Range("M" & rowNum).Value = Trim(cacheVal(2)) + ws.Range("L" & rowNum).Value = Trim(cacheVal(1)) + ws.Range("M" & rowNum).Value = Trim(cacheVal(2)) Case Else Exit Sub End Select @@ -190,9 +190,7 @@ Private Sub CreateJDropdown(ByVal rowNum As Long) End If End Sub -Private Sub FillFromM1(ByVal rowNum As Long) - Set ws = Me - +Private Sub FillFromM1(ByVal ws As Worksheet, ByVal rowNum As Long) Dim m1Cache As Object: Set m1Cache = GetCache("M1") Dim cValue As String: cValue = Trim(ws.Range("C" & rowNum).Value) @@ -395,6 +393,39 @@ Public Sub ImportCSVAndTriggerChange(ws As Worksheet, ByVal lastDataRow As Long) Dim startRow As Long: startRow = sheetConf("StartRow") Dim i As Long For i = startRow To lastDataRow - Call FillFromM1(i) + Call FillFromM1(ws, i) Next i End Sub + +' obtain T1/T2/T3 cache data, and update column K +Private Sub Refresh(ws As Worksheet, ByVal startRow As Long, ByVal lastDataRow As Long) + Dim kenshuList As Object: Set kenshuList = GetCache("kenshuList") + If kenshuList Is Nothing Then Exit Sub + + Application.EnableEvents = False + On Error GoTo Finally + + Dim r As Long + For r = startRow To lastDataRow + Dim cValue As String: cValue = Trim(ws.Cells(r, 3).Value) ' Column C + + ' Skip if C column is empty + If cValue = "" Then + GoTo NextRow + End If + + ' Reuse FillFromM1 method to fill D-H columns + Call FillFromM1(ws, r) + + ' Reuse FillKFromJ method to fill J-K columns + Dim iValue As String: iValue = Trim(ws.Cells(r, 9).Value) ' Column I + If iValue <> "" And kenshuList.Exists(iValue) Then + Call FillKFromJ(ws, r) + End If + +NextRow: + Next r + +Finally: + Application.EnableEvents = True +End Sub diff --git a/通勤手当テンプレート20260515.xlsm b/通勤手当テンプレート20260515.xlsm new file mode 100644 index 0000000..3a0e206 Binary files /dev/null and b/通勤手当テンプレート20260515.xlsm differ