通勤認定エクセルツール対応12 Z4マスタ追加

2026-05-27 11:23:26 +09:00
parent ca2ae646fb
commit 1a0010b464
19 changed files with 163 additions and 343 deletions
--- a/src/sh/tuk/module/Common_Button.bas
+++ b/src/sh/tuk/module/Common_Button.bas
@@ -49,7 +49,7 @@ Sub RefreshCache_Button()
    Dim activeSheetName As String: activeSheetName = ActiveSheet.CodeName

    Debug.Print "1. Validate Z1~Z4, T1~T3, O1~O3 master data"
-    Dim cacheSheets As Variant: cacheSheets = Array("Z1", "Z2", "Z3", "T1", "T2", "T3", "O1", "O2", CACHE_O3)
+    Dim cacheSheets As Variant: cacheSheets = Array(CACHE_Z1, CACHE_Z2, CACHE_Z3, CACHE_Z4, CACHE_T1, CACHE_T2, CACHE_T3, CACHE_O1, CACHE_O2, CACHE_O3)
    Dim sheetName As Variant
    Dim ws As Worksheet
    For Each sheetName In cacheSheets
@@ -325,7 +325,7 @@ Private Sub Do_Filter(ws As Excel.Worksheet)
        Exit Sub
    End If

-    Dim startCol As Long: startCol = ws.Range(sheetConf("StartCol") & "1").Column
+    Dim startCol As Long: startCol = ws.Range(sheetConf("ErrorCol") & "1").Column
    Dim endCol As Long: endCol = ws.Range(sheetConf("EndCol") & "1").Column

    Dim filterRow As Long: filterRow = sheetConf("FilterRow")
--- a/src/sh/tuk/module/Common_Global_Cache.bas
+++ b/src/sh/tuk/module/Common_Global_Cache.bas
@@ -8,7 +8,17 @@ Option Explicit
 '   - RefreshM2Cache
 '   - RefreshO1Cache
 ' ============================================================
-Public Const CACHE_O3 As String = CACHE_O3
+Public Const CACHE_Z1 As String = "Z1"
+Public Const CACHE_Z2 As String = "Z2"
+Public Const CACHE_Z3 As String = "Z3"
+Public Const CACHE_Z4 As String = "Z4"
+Public Const CACHE_T1 As String = "T1"
+Public Const CACHE_T2 As String = "T2"
+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"
+


 Private sheetConfDict As Object
@@ -53,7 +63,7 @@ Public Sub RefreshCache(ByVal cacheName As String)
        Set loadedData = LookupM1KukanCache()
    ElseIf cacheName = "M2" Then
        Set loadedData = LookupM2Cache()
-    ElseIf cacheName = "O1" Then
+    ElseIf cacheName = CACHE_O1 Then
        Set loadedData = LookupO1Cache()
    ElseIf Contains(sheetConfDict("Enum"), cacheName) Then
        Set loadedData = LoadLookup("Enum", cacheName)
@@ -217,11 +227,11 @@ Private Function LookupO1Cache() As Object
    
    Dim ws As Worksheet
    On Error Resume Next
-    Set ws = ThisWorkbook.Worksheets("O1")
+    Set ws = ThisWorkbook.Worksheets(CACHE_O1)
    On Error GoTo ErrHandler
    ' ws exists, continue
    
-    Dim sheetConf As Object: Set sheetConf = sheetConfDict("O1")
+    Dim sheetConf As Object: Set sheetConf = sheetConfDict(CACHE_O1)
    Dim startRow As Long: startRow = sheetConf("StartRow")
    Dim lastRow As Long: lastRow = GetLastDataRowInRange(ws)
    If lastRow < startRow Then 
@@ -345,7 +355,7 @@ Private Sub RefreshSheetDict()
    sheetConf("FilterRow") = 6
    sheetConf("KeyCol") = 3
    sheetConf("ValueCols") = Array(4)
-    Set sheetConfDict("Z1") = sheetConf
+    Set sheetConfDict(CACHE_Z1) = sheetConf
    Debug.Print "RefreshSheetDict Z1 ok."

    ' Z2
@@ -363,7 +373,7 @@ Private Sub RefreshSheetDict()
    sheetConf("FilterRow") = 6
    sheetConf("KeyCol") = 3
    sheetConf("ValueCols") = Array(4)
-    Set sheetConfDict("Z2") = sheetConf
+    Set sheetConfDict(CACHE_Z2) = sheetConf
    Debug.Print "RefreshSheetDict Z2 ok."

    ' Z3
@@ -381,9 +391,27 @@ Private Sub RefreshSheetDict()
    sheetConf("FilterRow") = 6
    sheetConf("KeyCol") = 3
    sheetConf("ValueCols") = Array(4)
-    Set sheetConfDict("Z3") = sheetConf
+    Set sheetConfDict(CACHE_Z3) = sheetConf
    Debug.Print "RefreshSheetDict Z3 ok."

+    ' Z4
+    Set sheetConf = CreateObject("Scripting.Dictionary")
+    sheetConf("StartCol") = "C"
+    sheetConf("EndCol") = "H"
+    sheetConf("ErrorCol") = "B"
+    sheetConf("StartRow") = 7
+    sheetConf("HeaderRow") = 5
+    sheetConf("CSV_Encoding") = "utf-8"
+    sheetConf("HasHeader") = False
+    sheetConf("ExpectedColumnCount") = 6
+    sheetConf("HeaderColumns") = Array("C", "D", "E", "F", "G", "H")
+    sheetConf("AlwaysQuote") = True
+    sheetConf("FilterRow") = 6
+    sheetConf("KeyCol") = 3
+    sheetConf("ValueCols") = Array(4)
+    Set sheetConfDict("Z4") = sheetConf
+    Debug.Print "RefreshSheetDict Z4 ok."
+
    ' T1
    Set sheetConf = CreateObject("Scripting.Dictionary")
    sheetConf("StartCol") = "C"
@@ -399,7 +427,7 @@ Private Sub RefreshSheetDict()
    sheetConf("FilterRow") = 6
    sheetConf("KeyCol") = 3
    sheetConf("ValueCols") = Array(4)
-    Set sheetConfDict("T1") = sheetConf
+    Set sheetConfDict(CACHE_T1) = sheetConf
    Debug.Print "RefreshSheetDict T1 ok."

    ' T2
@@ -417,7 +445,7 @@ Private Sub RefreshSheetDict()
    sheetConf("FilterRow") = 6
    sheetConf("KeyCol") = 3
    sheetConf("ValueCols") = Array(4, 8, 9, 10, 11, 12, 13)
-    Set sheetConfDict("T2") = sheetConf
+    Set sheetConfDict(CACHE_T2) = sheetConf
    Debug.Print "RefreshSheetDict T2 ok."

    ' T3
@@ -435,7 +463,7 @@ Private Sub RefreshSheetDict()
    sheetConf("FilterRow") = 6
    sheetConf("KeyCol") = 3
    sheetConf("ValueCols") = Array(4, 8, 9)
-    Set sheetConfDict("T3") = sheetConf
+    Set sheetConfDict(CACHE_T3) = sheetConf
    Debug.Print "RefreshSheetDict T3 ok."

    ' O1
@@ -451,7 +479,7 @@ Private Sub RefreshSheetDict()
    sheetConf("HeaderColumns") = Array("C", "D", "E", "F")
    sheetConf("AlwaysQuote") = True
    sheetConf("FilterRow") = 5
-    Set sheetConfDict("O1") = sheetConf
+    Set sheetConfDict(CACHE_O1) = sheetConf
    Debug.Print "RefreshSheetDict O1 ok."

    ' O2
@@ -469,7 +497,7 @@ Private Sub RefreshSheetDict()
    sheetConf("FilterRow") = 5
    sheetConf("KeyCol") = 3
    sheetConf("ValueCols") = Array(4)
-    Set sheetConfDict("O2") = sheetConf
+    Set sheetConfDict(CACHE_O2) = sheetConf
    Debug.Print "RefreshSheetDict O2 ok."

    ' O3
@@ -568,7 +596,7 @@ End Function
 Public Sub RefreshMasterCache()
    ' Fixed cache names
    Dim fixedCaches As Variant
-    fixedCaches = Array("Z1", "Z2", "Z3", "T1", "T2", "T3", "O1", "O2", CACHE_O3, _
+    fixedCaches = Array(CACHE_Z1, CACHE_Z2, CACHE_Z3, CACHE_T1, CACHE_T2, CACHE_T3, CACHE_O1, CACHE_O2, CACHE_O3, _
        "tokubetuList", "kenshuList", "renrakuList", "oufukuList", "koutaiList", "higaitouList", "errorList")
    
    ' Refresh fixed caches
@@ -604,15 +632,16 @@ Public Sub WriteCachesSheet(ByVal cacheName As String)
    ' Map cacheName to column letter
    Dim colLetter As String
    Select Case cacheName
-        Case "Z1": colLetter = "A"
-        Case "Z2": colLetter = "B"
-        Case "Z3": colLetter = "C"
-        Case CACHE_O3: colLetter = "D"
-        Case "T1": colLetter = "E"
-        Case "T2": colLetter = "F"
-        Case "T3": colLetter = "G"
-        Case "O2": colLetter = "H"
-        Case "M1": colLetter = "I"
+        Case CACHE_Z1: colLetter = "A"
+        Case CACHE_Z2: colLetter = "B"
+        Case CACHE_Z3: colLetter = "C"
+        Case CACHE_Z4: colLetter = "D"
+        Case CACHE_T1: colLetter = "E"
+        Case CACHE_T2: colLetter = "F"
+        Case CACHE_T3: colLetter = "G"
+        Case CACHE_O2: colLetter = "H"
+        Case CACHE_O3: colLetter = "I"
+        Case "M1": colLetter = "M"
        Case Else: Exit Sub
    End Select
    
--- a/src/sh/tuk/module/Common_Selector.bas
+++ b/src/sh/tuk/module/Common_Selector.bas
@@ -19,7 +19,7 @@ Option Explicit
 ' ============================================================
 ' Create Transport (T) dropdown from Z1 cache
 Public Function BuildTransportList()
-    Dim z1Cache As Object: Set z1Cache = GetCache("Z1")
+    Dim z1Cache As Object: Set z1Cache = GetCache(CACHE_Z1)

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

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

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

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

    Dim dropdownList As String
    Dim key As Variant
--- a/src/sh/tuk/sheet/C1.cls
+++ b/src/sh/tuk/sheet/C1.cls
@@ -109,7 +109,7 @@ Private Sub Worksheet_Change(ByVal Target As Range)
    ' Check if cache is loaded
    Application.EnableEvents = False
    On Error GoTo Finally
-    Dim testCache As Object: Set testCache = GetCache("Z1")
+    Dim testCache As Object: Set testCache = GetCache(CACHE_Z1)
    
    ' === Column C changes ===
    If Target.Column = 3 Then
@@ -272,7 +272,7 @@ Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
 End Sub

 Private Sub Refresh(ws As Worksheet, ByVal startRow As Long, ByVal lastDataRow As Long)
-    Dim z1Cache As Object: Set z1Cache = GetCache("Z1")
+    Dim z1Cache As Object: Set z1Cache = GetCache(CACHE_Z1)
    
    Application.EnableEvents = False
    On Error GoTo ErrorHandler
@@ -336,13 +336,13 @@ Private Sub RebuildDropdowns(ByVal rowNum As Long)
        End With
    Next i

-    Call BuildDropdownFromCacheNamedRange(Me, MMONTH_AMOUNT_KBN_COL, rowNum, "Z3")
+    Call BuildDropdownFromCacheNamedRange(Me, MMONTH_AMOUNT_KBN_COL, rowNum, CACHE_Z3)

 End Sub

 Private Sub ReFillFromDropdowns(ByVal rowNum As Long)
    
-    Dim z3Cache As Object: Set z3Cache = GetCache("Z3")
+    Dim z3Cache As Object: Set z3Cache = GetCache(CACHE_Z3)
    Dim valueStrMonthAmountKbn As String: valueStrMonthAmountKbn = Trim(Me.Cells(rowNum, MMONTH_AMOUNT_KBN_COL).Value)
    Dim monthAmountKbn As String: monthAmountKbn = GetCode(valueStrMonthAmountKbn)
    If z3Cache.Exists(monthAmountKbn) Then
@@ -430,7 +430,7 @@ End Sub
 ' when cshainno does not exist in o1, clear dropdownList and value
 ' when cshainno exist in o1, create dropdownList and value
 Private Sub BuildAddress1Dropdown(ByVal rowNum As Long, ByVal cshainno As String)
-    Dim o1Cache As Object: Set o1Cache = GetCache("O1")
+    Dim o1Cache As Object: Set o1Cache = GetCache(CACHE_O1)
    ' Build dropdown list from O1 cache: get all E values for the C
    Dim dropdownList As String
    If o1Cache.Exists(cshainno) Then
@@ -460,7 +460,7 @@ Private Sub BuildAddress1Dropdown(ByVal rowNum As Long, ByVal cshainno As String
 End Sub

 Private Sub ReFillAddress1(ByVal rowNum As Long, ByVal cshainno As String)
-    Dim o1Cache As Object: Set o1Cache = GetCache("O1")
+    Dim o1Cache As Object: Set o1Cache = GetCache(CACHE_O1)
    If Not o1Cache.Exists(cshainno) Then
        Me.Cells(rowNum, ADDRESS1_COL).Value = ""
        Exit Sub
@@ -487,7 +487,7 @@ End Sub
 Private Sub BuildAddress2Dropdown(ByVal rowNum As Long, ByVal cshainno As String)
    ' Clear address2 contents
    ' obtain cshainno, address1, o1Cache
-    Dim o1Cache As Object: Set o1Cache = GetCache("O1")
+    Dim o1Cache As Object: Set o1Cache = GetCache(CACHE_O1)
    Dim address1 As String: address1 = Trim(Me.Cells(rowNum, ADDRESS1_COL).Value)
    If cshainno = "" OR address1 = "" Then
        Exit Sub
@@ -534,7 +534,7 @@ Private Sub ReFillAddress2(ByVal rowNum As Long, ByVal cshainno As String)
        Exit Sub
    End If

-    Dim o1Cache As Object: Set o1Cache = GetCache("O1")
+    Dim o1Cache As Object: Set o1Cache = GetCache(CACHE_O1)
    If Not o1Cache.Exists(cshainno) Then
        Me.Cells(rowNum, ADDRESS2_COL).Value = ""
        Exit Sub
@@ -825,7 +825,7 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
    End If

    ' I column [address1 J column address2]
-    Dim o1Cache As Object: Set o1Cache = GetCache("O1")
+    Dim o1Cache As Object: Set o1Cache = GetCache(CACHE_O1)
    Dim ColI As String: ColI = "I"
    Dim ColJ As String: ColJ = "J"
    Dim address1 As String: address1 = Trim(Me.Cells(rowNum, ColI).Value)
--- a/src/sh/tuk/sheet/M1.cls
+++ b/src/sh/tuk/sheet/M1.cls
@@ -30,7 +30,7 @@ Private Sub Worksheet_Change(ByVal Target As Range)

    ' === Column D changes: Fill E column ===
    If Target.Column = 4 And Target.Row >= 7 Then
-        Dim z1Cache As Object: Set z1Cache = GetCache("Z1")
+        Dim z1Cache As Object: Set z1Cache = GetCache(CACHE_Z1)

        Dim cellD As Range
        For Each cellD In Target
@@ -109,7 +109,7 @@ Private Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
    End If

    ' Check D and E column in the cache
-    Dim z1Cache As Object: Set z1Cache = GetCache("Z1")
+    Dim z1Cache As Object: Set z1Cache = GetCache(CACHE_Z1)

    Dim dValue As String: dValue = Trim(ws.Range("D" & rowNum).Value)
    Dim eValue As String: eValue = Trim(ws.Range("E" & rowNum).Value)
@@ -157,7 +157,7 @@ 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")
+    Dim z1Cache As Object: Set z1Cache = GetCache(CACHE_Z1)
    
    Application.EnableEvents = False
    On Error GoTo ErrorHandler
--- a/src/sh/tuk/sheet/M2.cls
+++ b/src/sh/tuk/sheet/M2.cls
@@ -164,7 +164,7 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
    Dim equaledCols As Variant
    Dim emptyCols As Variant
    If kenshuKbn = "1" Then
-        Set cache = GetCache("T1")
+        Set cache = GetCache(CACHE_T1)
        ' must input
        equaledCols = Array("K")
        requiredCols = Array("N")
@@ -172,7 +172,7 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
    End If

    If kenshuKbn = "2" Then
-        Set cache = GetCache("T2")
+        Set cache = GetCache(CACHE_T2)
        ' must input
        equaledCols = Array("K", "L", "M", "N", "O", "P", "Q")
        requiredCols = Array("N", "O", "P", "Q")
@@ -180,7 +180,7 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
    End If

    If kenshuKbn = "3" Then
-        Set cache = GetCache("T3")
+        Set cache = GetCache(CACHE_T3)
        ' must input
        equaledCols = Array("K", "L", "M")
        requiredCols = Array()
@@ -320,11 +320,11 @@ Private Sub FillKFromJ(ByVal ws As Worksheet, ByVal rowNum As Long)
    Dim cache As Object
    Select Case kenshu
        Case "1"
-            Set cache = GetCache("T1")
+            Set cache = GetCache(CACHE_T1)
        Case "2"
-            Set cache = GetCache("T2")
+            Set cache = GetCache(CACHE_T2)
        Case "3"
-            Set cache = GetCache("T3")
+            Set cache = GetCache(CACHE_T3)
        Case Else
            Exit Sub
    End Select
--- a/src/sh/tuk/sheet/O3.cls
+++ b/src/sh/tuk/sheet/O3.cls
@@ -1,6 +1,6 @@
 ' ============================================================
-' Module Name: Master_Z4_220
-' Module Desc: Z4 master data management (220)
+' Module Name: Master_O3_220
+' Module Desc: O3 master data management (220)
 ' Module Methods:
 '   - Worksheet_Change
 '   - Validate
--- a/src/sh/tuk/sheet/Z4.cls
+++ b/src/sh/tuk/sheet/Z4.cls
@@ -0,0 +1,86 @@
+' ============================================================
+' Module Name: Master_Z4_221
+' Module Desc: Z4 master data management (221)
+' Module Methods:
+'   - Worksheet_Change
+'   - Validate
+' ============================================================
+
+' ============================================================
+' Event Handlers
+' ============================================================
+Private Sub Worksheet_Change(ByVal Target As Range)
+    Dim HasHeaderEdit As Boolean: HasHeaderEdit = CheckHeaderEdit(Me, Target)
+    If HasHeaderEdit = True Then Exit Sub
+
+End Sub
+
+' Prevent insert/delete row in header area
+Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
+    Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
+    Dim sheetConf As Object: Set sheetConf = sheetConfDict(Me.CodeName)
+    Dim filterRow As Long: filterRow = sheetConf("FilterRow")
+
+    If Target.Row < filterRow + 1 Then
+        Cancel = True
+        MsgBox "Cannot insert or delete row in header area.", vbExclamation
+    End If
+End Sub
+
+' 
+Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As Long)
+    On Error GoTo ErrHandler
+    
+    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 errorCol As String: errorCol = sheetConf("ErrorCol")
+    
+    ' clear C~I columns background color
+    Dim clearRange As Range: Set clearRange = ws.Range(ws.Cells(rowNum, startCol), ws.Cells(rowNum, endCol))
+    clearRange.Interior.Color = vbWhite
+    
+    ' C column check
+    checkResult = CheckRequired(ws, rowNum, 3, errorCol)
+    If checkResult = False Then Exit Sub
+
+    checkResult = CheckChar(ws, rowNum, 3, 2, errorCol)
+    If checkResult = False Then Exit Sub
+
+    checkResult = CheckAlphanumeric(ws, rowNum, 3, 2, errorCol)
+    If checkResult = False Then Exit Sub
+
+    checkResult = CheckDuplicate(ws, rowNum, 3, errorCol)
+    If checkResult = False Then Exit Sub
+    
+    ' D column check
+    checkResult = CheckRequired(ws, rowNum, 4, errorCol)
+    If checkResult = False Then Exit Sub
+
+    checkResult = CheckVarcharOver(ws, rowNum, 4, 80, errorCol)
+    If checkResult = False Then Exit Sub
+
+    ' E column check
+    checkResult = CheckVarcharOver(ws, rowNum, 5, 80, errorCol)
+    If checkResult = False Then Exit Sub
+    
+    ' F column check
+    checkResult = CheckVarcharOver(ws, rowNum, 6, 80, errorCol)
+    If checkResult = False Then Exit Sub
+
+    ' G column check
+    checkResult = CheckVarcharOver(ws, rowNum, 7, 80, errorCol)
+    If checkResult = False Then Exit Sub
+    
+    ' H column check
+    checkResult = Check01(ws, rowNum, 8, errorCol)
+    If checkResult = False Then Exit Sub
+
+    ws.Cells(rowNum, errorCol).ClearContents
+    Exit Sub
+
+ErrHandler:
+    lastErrorMsg = Err.Description
+End Sub