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

通勤認定エクセルツール対応13 M1 対応2

Browse Source
This commit is contained in:
guanxiangwei
2026-05-28 20:57:47 +09:00
parent 50ef0c74cc
commit 29c9200132
15 changed files with 730 additions and 318 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/sh/tuk/module/Common_Global_Cache.bas
+29 -42
View File
@@ -19,7 +19,8 @@ Public Const CACHE_T3 As String = "T3"
Public Const CACHE_O1 As String = "O1"
Public Const CACHE_O2 As String = "O2"
Public Const CACHE_O3 As String = "O3"
Public Const CACHE_M1 As String = "M1"
Public Const CACHE_M2 As String = "M2"
Private sheetConfDict As Object
@@ -62,7 +63,7 @@ Public Sub RefreshCache(ByVal cacheName As String)
Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
If cacheName = "M1KukanDCache" Then
Set loadedData = LookupM1KukanCache()
ElseIf cacheName = "M2" Then
ElseIf cacheName = CACHE_M2 Then
Set loadedData = LookupM2Cache()
ElseIf cacheName = CACHE_O1 Then
Set loadedData = LookupO1Cache()
@@ -88,12 +89,9 @@ Private Function LookupM1KukanCache()
On Error GoTo ErrHandler
Dim ws As Worksheet
On Error Resume Next
Set ws = ThisWorkbook.Worksheets("M1")
On Error GoTo ErrHandler
' ws exists, continue
Set ws = ThisWorkbook.Worksheets(CACHE_M1)
Dim sheetConf As Object: Set sheetConf = sheetConfDict("M1")
Dim sheetConf As Object: Set sheetConf = sheetConfDict(CACHE_M1)
Dim startRow As Long: startRow = sheetConf("StartRow")
Dim lastRow As Long: lastRow = GetLastDataRowInRange(ws)
If lastRow < startRow Then
@@ -152,12 +150,9 @@ Private Function LookupM2Cache() As Object
On Error GoTo ErrHandler
Dim ws As Worksheet
On Error Resume Next
Set ws = ThisWorkbook.Worksheets("M2")
On Error GoTo ErrHandler
' ws exists, continue
Set ws = ThisWorkbook.Worksheets(CACHE_M2)
Dim sheetConf As Object: Set sheetConf = sheetConfDict("M2")
Dim sheetConf As Object: Set sheetConf = sheetConfDict(CACHE_M2)
Dim startRow As Long: startRow = sheetConf("StartRow")
Dim lastRow As Long: lastRow = GetLastDataRowInRange(ws)
If lastRow < startRow Then
@@ -229,10 +224,7 @@ Private Function LookupO1Cache() As Object
On Error GoTo ErrHandler
Dim ws As Worksheet
On Error Resume Next
Set ws = ThisWorkbook.Worksheets(CACHE_O1)
On Error GoTo ErrHandler
' ws exists, continue
Dim sheetConf As Object: Set sheetConf = sheetConfDict(CACHE_O1)
Dim startRow As Long: startRow = sheetConf("StartRow")
@@ -289,7 +281,7 @@ End Function
' ============================================================
' Z4 Rosen Cache - nested dict for M1 E/F/H cascade dropdown
' Structure: { rosen [F]: { stationFrom [D]: [stationTo E, ...] } }
' Structure: { rosen [F]: { station [D]: True } }
' ============================================================
Private Function LookupZ4RosenCache() As Object
Dim resultCache As Object
@@ -309,31 +301,25 @@ Private Function LookupZ4RosenCache() As Object
End If
Dim r As Long
For r = startRow To lastRow
Dim rosen As String: rosen = Trim(ws.Cells(r, 6).Value)
Dim stationFrom As String: stationFrom = Trim(ws.Cells(r, 4).Value)
Dim stationTo As String: stationTo = Trim(ws.Cells(r, 5).Value)
Dim station As String
Dim rosen As String
Dim innerDict As Object
If rosen = "" Or stationFrom = "" Then GoTo NextRow3
For r = startRow To lastRow
rosen = Trim(ws.Cells(r, 6).Value)
station = Trim(ws.Cells(r, 4).Value)
If rosen = "" Or station = "" Then GoTo NextRow3
If Not resultCache.Exists(rosen) Then
Dim innerDict As Object
Set innerDict = CreateObject("Scripting.Dictionary")
innerDict.CompareMode = vbTextCompare
resultCache.Add rosen, innerDict
End If
Set innerDict = resultCache(rosen)
If Not innerDict.Exists(stationFrom) Then
Dim arr As Object
Set arr = CreateObject("Scripting.Dictionary")
arr.CompareMode = vbTextCompare
innerDict.Add stationFrom, arr
End If
Set arr = innerDict(stationFrom)
If stationTo <> "" And Not arr.Exists(stationTo) Then
arr.Add stationTo, True
If Not innerDict.Exists(station) Then
innerDict.Add station, True
End If
NextRow3:
@@ -387,7 +373,7 @@ Private Sub RefreshSheetDict()
sheetConf("FilterRow") = 6
sheetConf("KeyCol") = 3
sheetConf("ValueCols") = Array(3, 4, 5, 6, 7, 9, 12)
Set sheetConfDict("M1") = sheetConf
Set sheetConfDict(CACHE_M1) = sheetConf
Debug.Print "RefreshSheetDict M1 ok."
' M2
@@ -403,7 +389,7 @@ Private Sub RefreshSheetDict()
sheetConf("HeaderColumns") = Array("C", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R")
sheetConf("AlwaysQuote") = False
sheetConf("FilterRow") = 7
Set sheetConfDict("M2") = sheetConf
Set sheetConfDict(CACHE_M2) = sheetConf
Debug.Print "RefreshSheetDict M2 ok."
' Z1
@@ -479,7 +465,7 @@ Private Sub RefreshSheetDict()
sheetConf("FilterRow") = 6
sheetConf("KeyCol") = 3
sheetConf("ValueCols") = Array(4)
Set sheetConfDict("Z4") = sheetConf
Set sheetConfDict(CACHE_Z4) = sheetConf
Debug.Print "RefreshSheetDict Z4 ok."
' T1
@@ -517,6 +503,7 @@ Private Sub RefreshSheetDict()
sheetConf("FilterRow") = 6
sheetConf("KeyCol") = 3
sheetConf("ValueCols") = Array(4, 8, 9, 10, 11, 12, 13)
sheetConf("ZeroFillCols") = Array("H", "I", "J", "K", "L", "M")
Set sheetConfDict(CACHE_T2) = sheetConf
Debug.Print "RefreshSheetDict T2 ok."
@@ -695,15 +682,15 @@ Public Sub RefreshMasterCache()
End Sub
Public Sub RefreshKukanCache(ByVal sheetName As String)
If sheetName = "M1" Then
Call RefreshCache("M1")
If sheetName = CACHE_M1 Then
Call RefreshCache(CACHE_M1)
Call RefreshCache("M1KukanDCache")
Call RefreshCache(CACHE_Z4ROSEN)
Call WriteCachesSheet("M1")
Call WriteCachesSheet(CACHE_M1)
End If
If sheetName = "M2" Then
Call RefreshCache("M2")
Call WriteCachesSheet("M2")
If sheetName = CACHE_M2 Then
Call RefreshCache(CACHE_M2)
Call WriteCachesSheet(CACHE_M2)
End If
End Sub
@@ -729,7 +716,7 @@ Public Sub WriteCachesSheet(ByVal cacheName As String)
Case CACHE_T3: colLetter = "G"
Case CACHE_O2: colLetter = "H"
Case CACHE_O3: colLetter = "I"
Case "M1": colLetter = "M"
Case CACHE_M1: colLetter = "M"
Case Else: Exit Sub
End Select