updsv7/vba
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

20260515指摘対応3

Browse Source
This commit is contained in:
guanxiangwei
2026-05-15 18:33:15 +09:00
parent fa8bd26757
commit 553148202c
5 changed files with 130 additions and 30 deletions
Download Patch File Download Diff File Expand all files Collapse all files

35
src/sh/tuk/module/Common_Button.bas
View File

@@ -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

33
src/sh/tuk/module/Common_Global_Cache.bas
View File

@@ -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

21
src/sh/tuk/sheet/M1.cls
View File

@@ -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

71
src/sh/tuk/sheet/M2.cls
View File

@@ -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

BIN
通勤手当テンプレート20260515.xlsm Normal file
View File

Binary file not shown.