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

2026-05-28 12:58:08 +09:00
parent df9cd0a7ad
commit 50ef0c74cc
14 changed files with 602 additions and 199 deletions
--- a/AGENTS.md
+++ b/AGENTS.md
@@ -17,11 +17,13 @@
 ### Mandatory Rules
 - ✅ Every module must start with `Option Explicit`
 - ✅ All Public procedures must have a comment header (description, params, return value, author, date)
- ✅ `On Error Resume Next` is forbidden as global error handling. Only allowed in small scopes paired with `On Error GoTo 0`
+- ✅ `On Error Resume Next` is completely forbidden. Missing sheet/object should raise error directly via `Err.Raise ERR_SHEET_MISSING`. Do not suppress errors when checking if a sheet/worksheet/object exists.
 - ✅ Object variables must be explicitly `Set obj = Nothing` in `Finally` block or at end of procedure
 - ✅ Long operations must disable `ScreenUpdating`, `Calculation`, `EnableEvents` and restore on exit
+- ✅ Comments must be in **English only**. No Chinese, Japanese, or Korean characters allowed in any code comments or inline documentation
 - ❌ Forbidden: `Select` / `Selection` / `ActiveCell`. Always reference Range/Worksheet objects directly
 - ❌ Forbidden: hardcoded file paths or connection strings. Use config sheet or constants module
+- ❌ Forbidden: non-English comments (Chinese / Japanese / Korean)

 ## Project Structure

--- a/src/sh/tuk/module/Common_Button.bas
+++ b/src/sh/tuk/module/Common_Button.bas
@@ -6,46 +6,25 @@ Public lastErrorMsg As String

 ' ============================================================
 ' Module Name: Common_Button
-' Module Desc: Common Button handlers with centralized error handling
-' Module Methods:
-'   - CSV_Import_Button
-'   - Validation_Button
-'   - CSV_Export_Button
-'   - Sort_Button
-'   - Filter_Button
+' Module Desc: Common button handlers with centralized error handling
+' Public Methods:
+'   - CSV_Import_Button    (CSV import entry, binds to sheet button)
+'   - Validation_Button    (validation entry, binds to sheet button)
+'   - CSV_Export_Button    (CSV export entry, binds to sheet button)
+'   - Sort_Button          (sort entry, binds to sheet button)
+'   - Filter_Button       (filter entry, binds to sheet button)
+'   - Fit_Button          (autofit column width, binds to sheet button)
+'   - RefreshCache_Button (refresh master cache)
+'   - RunValidationSilent (validate sheet, returns row count or -1)
+'   - HandleError         (centralized error handler)
+' Private Methods:
+'   - ValidateKukanCache
+'   - UpdateByMaster
 '   - Fit_Button
-'   - RefreshCache_Button
 ' ============================================================

-' --- Public Button Functions ---
-
-Sub CSV_Import_Button()
-    DO_CSV_Import ActiveSheet
-End Sub
-
-Sub Validation_Button()
-    Do_Validation ActiveSheet
-End Sub
-
-Sub CSV_Export_Button()
-    DO_CSV_Export ActiveSheet
-End Sub
-
-Sub Sort_Button()
-    Do_Sort ActiveSheet
-End Sub
-
-Sub Filter_Button()
-    Do_Filter ActiveSheet
-End Sub
-
-Sub Fit_Button()
-    Do_Fit ActiveSheet
-End Sub
-
 Sub RefreshCache_Button()
    On Error GoTo ErrorHandler
-    Dim exitMsg As String
    Dim activeSheetName As String: activeSheetName = ActiveSheet.CodeName

    Debug.Print "1. Validate Z1~Z4, T1~T3, O1~O3 master data"
@@ -115,9 +94,10 @@ Private Sub UpdateByMaster(ByVal sheetName As String)
 End Sub

 ' ============================================================
-' CSV Import with error handler
+' CSV Import entry point (binds to sheet button)
 ' ============================================================
-Private Sub DO_CSV_Import(ws As Excel.Worksheet)
+Public Sub CSV_Import_Button()
+    Dim ws As Worksheet: Set ws = ActiveSheet
    On Error GoTo ErrorHandler

    ' Step 1: get csv encoding
@@ -137,9 +117,9 @@ Private Sub DO_CSV_Import(ws As Excel.Worksheet)
    End If

    ' === Step 4: Clear all data rows before import ===
-    Call ClearDataRows(ws)
    Application.ScreenUpdating = False
    Application.EnableEvents = False
+    Call ClearDataRows(ws)

    ' === Step 5: Write CSV data to worksheet ===
    Dim colLetters As Variant: colLetters = cfg("HeaderColumns")
@@ -169,10 +149,12 @@ FinallyExit:
 End Sub

 ' ============================================================
-' Do_Validation with HandleError
+' Do_Validation entry point (binds to sheet button)
 ' ============================================================
-Private Sub Do_Validation(ws As Excel.Worksheet)
+Public Sub Validation_Button()
+    Dim ws As Worksheet: Set ws = ActiveSheet
    On Error GoTo ErrorHandler
+    Application.EnableEvents = False

    Dim result As Long: result = RunValidationSilent(ws)
    
@@ -197,22 +179,22 @@ Private Sub Do_Validation(ws As Excel.Worksheet)
        Application.Run "M1.ValidateWarn", ws, lastDataRow
    End If

-    GoTo FinallyExit
+    Do_Fit_Internal ws
+    Application.EnableEvents = True
    Exit Sub

 ErrorHandler:
+    Application.EnableEvents = True
    HandleError "Do_Validation"
-    GoTo FinallyExit
+    Do_Fit_Internal ws

-FinallyExit:
-    Do_Fit ws
-    ClearFormatsBelowLastDataRow ws
 End Sub

 ' ============================================================
-' CSV Export with HandleError
+' CSV Export entry point (binds to sheet button)
 ' ============================================================
-Private Sub DO_CSV_Export(ws As Excel.Worksheet)
+Public Sub CSV_Export_Button()
+    Dim ws As Worksheet: Set ws = ActiveSheet
    On Error GoTo ErrorHandler

    ' === Step 1: Validate all rows before export ===
@@ -284,10 +266,12 @@ ErrorHandler:
    HandleError "DO_CSV_Export"
 End Sub

+
 ' ============================================================
-' Do_Sort with HandleError
+' Do_Sort entry point (binds to sheet button)
 ' ============================================================
-Private Sub Do_Sort(ws As Excel.Worksheet)
+Public Sub Sort_Button()
+    Dim ws As Worksheet: Set ws = ActiveSheet
    On Error GoTo ErrorHandler

    Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
@@ -303,9 +287,7 @@ Private Sub Do_Sort(ws As Excel.Worksheet)
    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.Goto sortRange
    Application.Dialogs(xlDialogSort).Show
    Exit Sub

@@ -313,10 +295,12 @@ ErrorHandler:
    HandleError "Do_Sort"
 End Sub

+
 ' ============================================================
-' Do_Filter with HandleError
+' Do_Filter entry point (binds to sheet button)
 ' ============================================================
-Private Sub Do_Filter(ws As Excel.Worksheet)
+Public Sub Filter_Button()
+    Dim ws As Worksheet: Set ws = ActiveSheet
    On Error GoTo ErrorHandler

    Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
@@ -341,10 +325,14 @@ ErrorHandler:
    HandleError "Do_Filter"
 End Sub

+Public Sub Fit_Button()
+    Do_Fit_Internal ActiveSheet
+End Sub
+
 ' ============================================================
-' Do_Fit with HandleError
+' Do_Fit internal implementation
 ' ============================================================
-Private Sub Do_Fit(ws As Excel.Worksheet)
+Private Sub Do_Fit_Internal(ws As Excel.Worksheet)
    On Error GoTo ErrorHandler

    Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
--- a/src/sh/tuk/module/Common_Functions.bas
+++ b/src/sh/tuk/module/Common_Functions.bas
@@ -261,7 +261,6 @@ Sub ClearDataRows(ByVal ws As Worksheet)
    Dim endCol As String: endCol = sheetConf("EndCol")
    Dim errorCol As String: errorCol = sheetConf("ErrorCol")

-    Application.EnableEvents = False
    Dim lastDataRow As Long: lastDataRow = GetLastDataRowInRange(ws)
    If lastDataRow >= startRow Then
        Dim clearRange As Range
@@ -278,13 +277,11 @@ Sub ClearDataRows(ByVal ws As Worksheet)
    End If
    
    ' Clear formats below lastDataRow (including dropdowns)
-    Application.EnableEvents = True
    Call ClearFormatsBelowLastDataRow(ws)
 End Sub

 'Clear formats below lastDataRow
 Sub ClearFormatsBelowLastDataRow(ws As Worksheet)
-    On Error GoTo ErrorHandler
    Dim lastRow As Long: lastRow = GetLastDataRowInRange(ws)

    Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
@@ -302,14 +299,9 @@ Sub ClearFormatsBelowLastDataRow(ws As Worksheet)
        ws.Cells(ws.Rows.Count, endCol) _
    )

-    Application.EnableEvents = False
    clearRange.ClearContents
    clearRange.Interior.Color = vbWhite
    clearRange.Validation.Delete
-    Application.EnableEvents = True
-
-ErrorHandler:
-    Application.EnableEvents = True
 End Sub

 ' Check if text starts with prefix
--- a/src/sh/tuk/module/Common_Global_Cache.bas
+++ b/src/sh/tuk/module/Common_Global_Cache.bas
@@ -12,6 +12,7 @@ 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_Z4ROSEN As String = "Z4Rosen"
 Public Const CACHE_T1 As String = "T1"
 Public Const CACHE_T2 As String = "T2"
 Public Const CACHE_T3 As String = "T3"
@@ -65,6 +66,8 @@ Public Sub RefreshCache(ByVal cacheName As String)
        Set loadedData = LookupM2Cache()
    ElseIf cacheName = CACHE_O1 Then
            Set loadedData = LookupO1Cache()
+        ElseIf cacheName = CACHE_Z4ROSEN Then
+            Set loadedData = LookupZ4RosenCache()
        ElseIf Contains(sheetConfDict("Enum"), cacheName) Then
        Set loadedData = LoadLookup("Enum", cacheName)
    Else
@@ -284,6 +287,69 @@ ErrHandler:
    End If
 End Function

+' ============================================================
+' Z4 Rosen Cache - nested dict for M1 E/F/H cascade dropdown
+' Structure: { rosen [F]: { stationFrom [D]: [stationTo E, ...] } }
+' ============================================================
+Private Function LookupZ4RosenCache() As Object
+    Dim resultCache As Object
+    Set resultCache = CreateObject("Scripting.Dictionary")
+    resultCache.CompareMode = vbTextCompare
+
+    On Error GoTo ErrHandler
+
+    Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets(CACHE_Z4)
+
+    Dim sheetConf As Object: Set sheetConf = GetSheetConfig()(CACHE_Z4)
+    Dim startRow As Long: startRow = sheetConf("StartRow")
+    Dim lastRow As Long: lastRow = GetLastDataRowInRange(ws)
+    If lastRow < startRow Then
+        Set LookupZ4RosenCache = resultCache
+        Exit Function
+    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)
+
+        If rosen = "" Or stationFrom = "" 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
+        End If
+
+NextRow3:
+    Next r
+
+    Set LookupZ4RosenCache = resultCache
+    Exit Function
+
+ErrHandler:
+    If Err.Number = 9 Then
+        Err.Raise ERR_SHEET_MISSING, "LookupZ4RosenCache", "Sheet 'Z4' not found."
+    Else
+        Err.Raise ERR_CACHE_NOT_FOUND, "LookupZ4RosenCache", "Failed to load Z4Rosen cache: " & Err.Description
+    End If
+End Function
+
 Private Sub RefreshSheetDict()
    Debug.Print "RefreshSheetDict begin."
    Set sheetConfDict = CreateObject("Scripting.Dictionary")
@@ -345,6 +411,7 @@ Private Sub RefreshSheetDict()
        sheetConf("StartCol") = "C"
        sheetConf("EndCol") = "I"
        sheetConf("ErrorCol") = "B"
+        sheetConf("DisplayCol") = "H"
        sheetConf("StartRow") = 7
        sheetConf("HeaderRow") = 5
        sheetConf("CSV_Encoding") = "utf-8"
@@ -363,6 +430,7 @@ Private Sub RefreshSheetDict()
        sheetConf("StartCol") = "C"
        sheetConf("EndCol") = "G"
        sheetConf("ErrorCol") = "B"
+        sheetConf("DisplayCol") = "G"
        sheetConf("StartRow") = 7
        sheetConf("HeaderRow") = 5
        sheetConf("CSV_Encoding") = "utf-8"
@@ -381,6 +449,7 @@ Private Sub RefreshSheetDict()
        sheetConf("StartCol") = "C"
        sheetConf("EndCol") = "H"
        sheetConf("ErrorCol") = "B"
+        sheetConf("DisplayCol") = "G"
        sheetConf("StartRow") = 7
        sheetConf("HeaderRow") = 5
        sheetConf("CSV_Encoding") = "utf-8"
@@ -418,6 +487,7 @@ Private Sub RefreshSheetDict()
        sheetConf("StartCol") = "C"
        sheetConf("EndCol") = "G"
        sheetConf("ErrorCol") = "B"
+        sheetConf("DisplayCol") = "G"
        sheetConf("StartRow") = 7
        sheetConf("HeaderRow") = 5
        sheetConf("CSV_Encoding") = "utf-8"
@@ -436,6 +506,7 @@ Private Sub RefreshSheetDict()
        sheetConf("StartCol") = "C"
        sheetConf("EndCol") = "M"
        sheetConf("ErrorCol") = "B"
+        sheetConf("DisplayCol") = "G"
        sheetConf("StartRow") = 7
        sheetConf("HeaderRow") = 5
        sheetConf("CSV_Encoding") = "utf-8"
@@ -454,6 +525,7 @@ Private Sub RefreshSheetDict()
        sheetConf("StartCol") = "C"
        sheetConf("EndCol") = "I"
        sheetConf("ErrorCol") = "B"
+        sheetConf("DisplayCol") = "G"
        sheetConf("StartRow") = 7
        sheetConf("HeaderRow") = 5
        sheetConf("CSV_Encoding") = "utf-8"
@@ -610,7 +682,7 @@ End Sub
 Public Sub RefreshMasterCache()
    ' Fixed cache names
    Dim fixedCaches As Variant
-    fixedCaches = Array(CACHE_Z1, CACHE_Z2, CACHE_Z3, CACHE_T1, CACHE_T2, CACHE_T3, CACHE_O1, CACHE_O2, CACHE_O3)
+    fixedCaches = Array(CACHE_Z1, CACHE_Z2, CACHE_Z3, CACHE_Z4, CACHE_Z4ROSEN, CACHE_T1, CACHE_T2, CACHE_T3, CACHE_O1, CACHE_O2, CACHE_O3)
    
    ' Refresh fixed caches
    Dim cacheName As Variant
@@ -626,6 +698,7 @@ Public Sub RefreshKukanCache(ByVal sheetName As String)
    If sheetName = "M1" Then
        Call RefreshCache("M1")
        Call RefreshCache("M1KukanDCache")
+        Call RefreshCache(CACHE_Z4ROSEN)
        Call WriteCachesSheet("M1")
    End If
    If sheetName = "M2" Then
--- a/src/sh/tuk/module/Common_Selector.bas
+++ b/src/sh/tuk/module/Common_Selector.bas
@@ -218,6 +218,77 @@ Public Sub BuildRenrakuDropdown(ws As Worksheet, ByVal columnLetter As String, B
    End With
 End Sub

+' ============================================================
+' Z4 Rosen Dropdown Builders for M1 E/F/H cascade
+' ============================================================
+
+' Build F column (station from) dropdown based on E column (rosen name)
+Public Sub BuildZ4StationFromDropdown(ws As Worksheet, ByVal columnLetter As String, ByVal rowNum As Long, ByVal rosen As String)
+    Dim z4RosenCache As Object: Set z4RosenCache = GetCache(CACHE_Z4ROSEN)
+
+    ws.Range(columnLetter & rowNum).Validation.Delete
+
+    If rosen = "" Then Exit Sub
+    If Not z4RosenCache.Exists(rosen) Then Exit Sub
+
+    Dim stationFromDict As Object: Set stationFromDict = z4RosenCache(rosen)
+    Dim dropdownList As String: dropdownList = ""
+    Dim stationFrom As Variant
+    For Each stationFrom In stationFromDict.Keys
+        If dropdownList = "" Then
+            dropdownList = stationFrom
+        Else
+            dropdownList = dropdownList & "," & stationFrom
+        End If
+    Next stationFrom
+
+    If dropdownList = "" Then Exit Sub
+
+    With ws.Range(columnLetter & rowNum).Validation
+        .Delete
+        .Add Type:=xlValidateList, Formula1:=dropdownList
+        .IgnoreBlank = True
+        .InCellDropdown = True
+        .InputTitle = ""
+        .InputMessage = ""
+    End With
+End Sub
+
+' Build H column (station to) dropdown based on E column (rosen name) and F column (station from)
+Public Sub BuildZ4StationToDropdown(ws As Worksheet, ByVal columnLetter As String, ByVal rowNum As Long, ByVal rosen As String, ByVal stationFrom As String)
+    Dim z4RosenCache As Object: Set z4RosenCache = GetCache(CACHE_Z4ROSEN)
+
+    ws.Range(columnLetter & rowNum).Validation.Delete
+
+    If rosen = "" Or stationFrom = "" Then Exit Sub
+    If Not z4RosenCache.Exists(rosen) Then Exit Sub
+
+    Dim stationFromDict As Object: Set stationFromDict = z4RosenCache(rosen)
+    If Not stationFromDict.Exists(stationFrom) Then Exit Sub
+
+    Dim stationToDict As Object: Set stationToDict = stationFromDict(stationFrom)
+    Dim dropdownList As String: dropdownList = ""
+    Dim stationTo As Variant
+    For Each stationTo In stationToDict.Keys
+        If dropdownList = "" Then
+            dropdownList = stationTo
+        Else
+            dropdownList = dropdownList & "," & stationTo
+        End If
+    Next stationTo
+
+    If dropdownList = "" Then Exit Sub
+
+    With ws.Range(columnLetter & rowNum).Validation
+        .Delete
+        .Add Type:=xlValidateList, Formula1:=dropdownList
+        .IgnoreBlank = True
+        .InCellDropdown = True
+        .InputTitle = ""
+        .InputMessage = ""
+    End With
+End Sub
+
 ' Create display dropdown
 Public Sub BuildDisplayDropdown(ws As Worksheet, ByVal rowNum As Long)
    ' validate sheet
--- a/src/sh/tuk/sheet/M1.cls
+++ b/src/sh/tuk/sheet/M1.cls
@@ -11,16 +11,18 @@ Private Sub Worksheet_Change(ByVal Target As Range)
    Dim HasHeaderEdit As Boolean: HasHeaderEdit = CheckHeaderEdit(Me, Target)
    If HasHeaderEdit = True Then Exit Sub
    
+    Application.EnableEvents = False
+    On Error GoTo Finally
+    
    ' Multi-cell selection not processed
-    If Target.Count > 1 Then Exit Sub
+    If Target.Count > 1 Then GoTo Finally
    
    ' === Column C changes: Create L column dropdown ===
    If Target.Column = 3 And Target.Row >= 7 Then
        Dim cell As Range
        For Each cell In Target
            If Trim(cell.Value) = "" Then
-                Me.Cells(cell.Row, 12).Validation.Delete
-                Call ClearDataRow(Me, START_COL + 1, END_COL, cell.Row, ERROR_COL)
+                Call ClearDataRow(Me, cell.Row)
            Else
                Call BuildTokubetuDropdown(Me, "L", cell.Row)
                Call BuildRenrakuDropdown(Me, "K", cell.Row)
@@ -31,22 +33,97 @@ 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(CACHE_Z1)
-
+        Dim z4Rosen As Object: Set z4Rosen = GetCache(CACHE_Z4ROSEN)
        Dim cellD As Range
        For Each cellD In Target
            Dim dVal As String: dVal = Trim(cellD.Value)
            If dVal = "" Then
                Me.Cells(cellD.Row, 5).ClearContents
+                Me.Cells(cellD.Row, 6).ClearContents
+                Me.Cells(cellD.Row, 7).ClearContents
+                Me.Cells(cellD.Row, 6).Validation.Delete
+                Me.Cells(cellD.Row, 7).Validation.Delete
            Else
-                If Not z1Cache Is Nothing And z1Cache.Exists(dVal) Then
-                    Dim valsD As Variant: valsD = z1Cache(dVal)
-                    Me.Cells(cellD.Row, 5).Value = valsD(0)
+                If z1Cache.Exists(dVal) Then
+                    Dim kikan As Variant: kikan = z1Cache(dVal)
+                    Dim kikanName As String: kikanName = kikan(0)
+                    Me.Cells(cellD.Row, 5).Value = kikanName
+
+                    If z4Rosen.Exists(kikanName) Then
+                        Call BuildZ4StationFromDropdown(Me, "F", cellD.Row, kikanName)
+                        Dim fromStations As Object: Set fromStations = z4Rosen(kikanName)
+                        Dim fromCell As Range: Set fromCell = Me.Cells(cellD.Row, 6)
+                        Dim fromStation As String: fromStation = Trim(fromCell.Value)
+                        If Not fromStations.Exists(fromStation) Or fromStation = "" Then
+                            fromCell.ClearContents
+                            Me.Cells(cellD.Row, 7).ClearContents
+                            Me.Cells(cellD.Row, 7).Validation.Delete
+                        Else
+                            Call BuildZ4StationToDropdown(Me, "G", cellD.Row, kikanName, fromStation)
+                            Dim toStations As Object: Set toStations = fromStations(fromStation)
+                            Dim toCell As Range: Set toCell = Me.Cells(cellD.Row, 7)
+                            Dim toStation As String: toStation = Trim(toCell.Value)
+                            
+                            If Not toStations.Exists(fromStation) Or toStation = "" Then
+                                toCell.ClearContents
+                            End If
+                        End If
+                    Else
+                        Me.Cells(cellD.Row, 6).ClearContents
+                        Me.Cells(cellD.Row, 7).ClearContents
+                        Me.Cells(cellD.Row, 6).Validation.Delete
+                        Me.Cells(cellD.Row, 7).Validation.Delete
+                    End If
+                    
                Else
                    Me.Cells(cellD.Row, 5).ClearContents
+                    Me.Cells(cellD.Row, 6).ClearContents
+                    Me.Cells(cellD.Row, 7).ClearContents
+                    Me.Cells(cellD.Row, 6).Validation.Delete
+                    Me.Cells(cellD.Row, 7).Validation.Delete
                End If
            End If
+            
+        Next
+    End If
+
+    ' === Column E changes (rosen name): Build F column (station from) dropdown ===
+    ' If Target.Column = 4 And Target.Row >= 7 Then
+    '     Dim cellE As Range
+    '     For Each cellE In Target
+    '         Dim rosenVal As String: rosenVal = Trim(cellE.Value)
+    '         If rosenVal = "" Then
+    '             Me.Cells(cellE.Row, 6).ClearContents
+    '             Me.Cells(cellE.Row, 8).ClearContents
+    '             Me.Cells(cellE.Row, 6).Validation.Delete
+    '             Me.Cells(cellE.Row, 8).Validation.Delete
+    '         Else
+    '             Call BuildZ4StationFromDropdown(Me, "F", cellE.Row, rosenVal)
+    '         End If
+    '     Next
+    ' End If
+
+    ' === Column F changes (station from): Build H column (station to) dropdown ===
+    If Target.Column = 6 And Target.Row >= 7 Then
+        Dim cellF As Range
+        For Each cellF In Target
+            Dim stationFrom As String: stationFrom = Trim(cellF.Value)
+            Dim rosenForH As String: rosenForH = Trim(Me.Cells(cellF.Row, 5).Value)
+            If stationFrom = "" Then
+                Me.Cells(cellF.Row, 7).ClearContents
+                Me.Cells(cellF.Row, 7).Validation.Delete
+            Else
+                Call BuildZ4StationToDropdown(Me, "G", cellF.Row, rosenForH, stationFrom)
+            End If
        Next
    End If
+
+    Application.EnableEvents = True
+    Exit Sub
+
+Finally:
+    HandleError "Worksheet_Change"
+    Application.EnableEvents = True
 End Sub

 ' Prevent insert/delete row in header area
--- a/src/sh/tuk/sheet/T1.cls
+++ b/src/sh/tuk/sheet/T1.cls
@@ -13,6 +13,38 @@ Private Sub Worksheet_Change(ByVal Target As Range)
    Dim HasHeaderEdit As Boolean: HasHeaderEdit = CheckHeaderEdit(Me, Target)
    If HasHeaderEdit = True Then Exit Sub

+    Application.EnableEvents = False
+    On Error GoTo Finally
+
+    ' === Column C changes: Create D column dropdown ===
+    If Target.Column = 3 And Target.Row >= 7 Then
+        Dim cell As Range
+        For Each cell In Target
+            If Trim(cell.Value) = "" Then
+                Call ClearDataRow(Me, cell.Row)
+            Else
+                Call BuildDisplayDropdown(Me, cell.Row)
+            End If
+        Next
+    End If
+
+    ' === Column G changes: Fill E column ===
+    If Target.Column = 7 And Target.Row >= 7 Then
+        Dim cellG As Range
+        For Each cellG In Target
+            Dim displayValue As String: displayValue = Trim(cellG.Value)
+            If displayValue <> "" Then
+                cellG.Value = GetCode(displayValue)
+            End If
+        Next
+    End If
+
+    Application.EnableEvents = True
+    Exit Sub
+
+Finally:
+    HandleError "Worksheet_Change"
+    Application.EnableEvents = True
 End Sub

 ' Prevent insert/delete row in header area
@@ -38,10 +70,12 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
    Dim endCol As String: endCol = sheetConf("EndCol")
    Dim errorCol As String: errorCol = sheetConf("ErrorCol")
    
-    ' clear C~I columns background color
+    ' clear C~G columns background color
    Dim clearRange As Range: Set clearRange = ws.Range(ws.Cells(rowNum, startCol), ws.Cells(rowNum, endCol))
    clearRange.Interior.Color = vbWhite

+    Dim checkResult As Boolean: checkResult = False
+
    ' C column check
    checkResult = CheckRequired(ws, rowNum, 3, errorCol)
    If checkResult = False Then Exit Sub
--- a/src/sh/tuk/sheet/T2.cls
+++ b/src/sh/tuk/sheet/T2.cls
@@ -13,6 +13,38 @@ Private Sub Worksheet_Change(ByVal Target As Range)
    Dim HasHeaderEdit As Boolean: HasHeaderEdit = CheckHeaderEdit(Me, Target)
    If HasHeaderEdit = True Then Exit Sub

+    Application.EnableEvents = False
+    On Error GoTo Finally
+
+    ' === Column C changes: Create D column dropdown ===
+    If Target.Column = 3 And Target.Row >= 7 Then
+        Dim cell As Range
+        For Each cell In Target
+            If Trim(cell.Value) = "" Then
+                Call ClearDataRow(Me, cell.Row)
+            Else
+                Call BuildDisplayDropdown(Me, cell.Row)
+            End If
+        Next
+    End If
+
+    ' === Column G changes: Fill E column ===
+    If Target.Column = 7 And Target.Row >= 7 Then
+        Dim cellG As Range
+        For Each cellG In Target
+            Dim displayValue As String: displayValue = Trim(cellG.Value)
+            If displayValue <> "" Then
+                cellG.Value = GetCode(displayValue)
+            End If
+        Next
+    End If
+
+    Application.EnableEvents = True
+    Exit Sub
+
+Finally:
+    HandleError "Worksheet_Change"
+    Application.EnableEvents = True
 End Sub

 ' Prevent insert/delete row in header area
@@ -38,17 +70,16 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
    Dim endCol As String: endCol = sheetConf("EndCol")
    Dim errorCol As String: errorCol = sheetConf("ErrorCol")
    
-    ' clear C~I columns background color
+    ' clear C~M columns background color
    Dim clearRange As Range: Set clearRange = ws.Range(ws.Cells(rowNum, startCol), ws.Cells(rowNum, endCol))
    clearRange.Interior.Color = vbWhite

+    Dim checkResult As Boolean: checkResult = False
+
    ' C column check
    checkResult = CheckRequired(ws, rowNum, 3, errorCol)
    If checkResult = False Then Exit Sub

-    checkResult = CheckChar(ws, rowNum, 3, 3, errorCol)
-    If checkResult = False Then Exit Sub
-
    checkResult = CheckAlphanumeric(ws, rowNum, 3, 3, errorCol)
    If checkResult = False Then Exit Sub

--- a/src/sh/tuk/sheet/T3.cls
+++ b/src/sh/tuk/sheet/T3.cls
@@ -13,6 +13,38 @@ Private Sub Worksheet_Change(ByVal Target As Range)
    Dim HasHeaderEdit As Boolean: HasHeaderEdit = CheckHeaderEdit(Me, Target)
    If HasHeaderEdit = True Then Exit Sub

+    Application.EnableEvents = False
+    On Error GoTo Finally
+
+    ' === Column C changes: Create D column dropdown ===
+    If Target.Column = 3 And Target.Row >= 7 Then
+        Dim cell As Range
+        For Each cell In Target
+            If Trim(cell.Value) = "" Then
+                Call ClearDataRow(Me, cell.Row)
+            Else
+                Call BuildDisplayDropdown(Me, cell.Row)
+            End If
+        Next
+    End If
+
+    ' === Column G changes: Fill E column ===
+    If Target.Column = 7 And Target.Row >= 7 Then
+        Dim cellG As Range
+        For Each cellG In Target
+            Dim displayValue As String: displayValue = Trim(cellG.Value)
+            If displayValue <> "" Then
+                cellG.Value = GetCode(displayValue)
+            End If
+        Next
+    End If
+
+    Application.EnableEvents = True
+    Exit Sub
+
+Finally:
+    HandleError "Worksheet_Change"
+    Application.EnableEvents = True
 End Sub

 ' Prevent insert/delete row in header area
@@ -42,6 +74,8 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
    Dim clearRange As Range: Set clearRange = ws.Range(ws.Cells(rowNum, startCol), ws.Cells(rowNum, endCol))
    clearRange.Interior.Color = vbWhite

+    Dim checkResult As Boolean: checkResult = False
+
    ' C column check
    checkResult = CheckRequired(ws, rowNum, 3, errorCol)
    If checkResult = False Then Exit Sub
--- a/src/sh/tuk/sheet/Z1.cls
+++ b/src/sh/tuk/sheet/Z1.cls
@@ -13,6 +13,38 @@ Private Sub Worksheet_Change(ByVal Target As Range)
    Dim HasHeaderEdit As Boolean: HasHeaderEdit = CheckHeaderEdit(Me, Target)
    If HasHeaderEdit = True Then Exit Sub

+    Application.EnableEvents = False
+    On Error GoTo Finally
+
+    ' === Column C changes: Create D column dropdown ===
+    If Target.Column = 3 And Target.Row >= 7 Then
+        Dim cell As Range
+        For Each cell In Target
+            If Trim(cell.Value) = "" Then
+                Call ClearDataRow(Me, cell.Row)
+            Else
+                Call BuildDisplayDropdown(Me, cell.Row)
+            End If
+        Next
+    End If
+
+    ' === Column H changes: Fill E column ===
+    If Target.Column = 8 And Target.Row >= 7 Then
+        Dim cellH As Range
+        For Each cellH In Target
+            Dim displayValue As String: displayValue = Trim(cellH.Value)
+            If displayValue <> "" Then
+                cellH.Value = GetCode(displayValue)
+            End If
+        Next
+    End If
+
+    Application.EnableEvents = True
+    Exit Sub
+
+Finally:
+    HandleError "Worksheet_Change"
+    Application.EnableEvents = True
 End Sub

 ' Prevent insert/delete row in header area
--- a/src/sh/tuk/sheet/Z2.cls
+++ b/src/sh/tuk/sheet/Z2.cls
@@ -13,6 +13,38 @@ Private Sub Worksheet_Change(ByVal Target As Range)
    Dim HasHeaderEdit As Boolean: HasHeaderEdit = CheckHeaderEdit(Me, Target)
    If HasHeaderEdit = True Then Exit Sub

+    Application.EnableEvents = False
+    On Error GoTo Finally
+
+    ' === Column C changes: Create D column dropdown ===
+    If Target.Column = 3 And Target.Row >= 7 Then
+        Dim cell As Range
+        For Each cell In Target
+            If Trim(cell.Value) = "" Then
+                Call ClearDataRow(Me, cell.Row)
+            Else
+                Call BuildDisplayDropdown(Me, cell.Row)
+            End If
+        Next
+    End If
+
+    ' === Column G changes: Fill E column ===
+    If Target.Column = 7 And Target.Row >= 7 Then
+        Dim cellG As Range
+        For Each cellG In Target
+            Dim displayValue As String: displayValue = Trim(cellG.Value)
+            If displayValue <> "" Then
+                cellG.Value = GetCode(displayValue)
+            End If
+        Next
+    End If
+
+    Application.EnableEvents = True
+    Exit Sub
+
+Finally:
+    HandleError "Worksheet_Change"
+    Application.EnableEvents = True
 End Sub

 ' Prevent insert/delete row in header area
@@ -38,10 +70,12 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
    Dim endCol As String: endCol = sheetConf("EndCol")
    Dim errorCol As String: errorCol = sheetConf("ErrorCol")
    
-    ' clear C~I columns background color
+    ' clear C~G columns background color
    Dim clearRange As Range: Set clearRange = ws.Range(ws.Cells(rowNum, startCol), ws.Cells(rowNum, endCol))
    clearRange.Interior.Color = vbWhite

+    Dim checkResult As Boolean: checkResult = False
+
    ' C column check
    checkResult = CheckRequired(ws, rowNum, 3, errorCol)
    If checkResult = False Then Exit Sub
--- a/src/sh/tuk/sheet/Z3.cls
+++ b/src/sh/tuk/sheet/Z3.cls
@@ -13,6 +13,38 @@ Private Sub Worksheet_Change(ByVal Target As Range)
    Dim HasHeaderEdit As Boolean: HasHeaderEdit = CheckHeaderEdit(Me, Target)
    If HasHeaderEdit = True Then Exit Sub

+    Application.EnableEvents = False
+    On Error GoTo Finally
+
+    ' === Column C changes: Create D column dropdown ===
+    If Target.Column = 3 And Target.Row >= 7 Then
+        Dim cell As Range
+        For Each cell In Target
+            If Trim(cell.Value) = "" Then
+                Call ClearDataRow(Me, cell.Row)
+            Else
+                Call BuildDisplayDropdown(Me, cell.Row)
+            End If
+        Next
+    End If
+
+    ' === Column G changes: Fill E column ===
+    If Target.Column = 7 And Target.Row >= 7 Then
+        Dim cellG As Range
+        For Each cellG In Target
+            Dim displayValue As String: displayValue = Trim(cellG.Value)
+            If displayValue <> "" Then
+                cellG.Value = GetCode(displayValue)
+            End If
+        Next
+    End If
+
+    Application.EnableEvents = True
+    Exit Sub
+
+Finally:
+    HandleError "Worksheet_Change"
+    Application.EnableEvents = True
 End Sub

 ' Prevent insert/delete row in header area
@@ -38,10 +70,12 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
    Dim endCol As String: endCol = sheetConf("EndCol")
    Dim errorCol As String: errorCol = sheetConf("ErrorCol")
    
-    ' clear C~I columns background color
+    ' clear C~H columns background color
    Dim clearRange As Range: Set clearRange = ws.Range(ws.Cells(rowNum, startCol), ws.Cells(rowNum, endCol))
    clearRange.Interior.Color = vbWhite
    
+    Dim checkResult As Boolean: checkResult = False
+
    ' C column check
    checkResult = CheckRequired(ws, rowNum, 3, errorCol)
    If checkResult = False Then Exit Sub
--- a/src/sh/tuk/sheet/Z4.cls
+++ b/src/sh/tuk/sheet/Z4.cls
@@ -13,11 +13,10 @@ Private Sub Worksheet_Change(ByVal Target As Range)
    Dim HasHeaderEdit As Boolean: HasHeaderEdit = CheckHeaderEdit(Me, Target)
    If HasHeaderEdit = True Then Exit Sub

-    ' Check if cache is loaded
    Application.EnableEvents = False
    On Error GoTo Finally

-    ' === Column C changes: Create L column dropdown ===
+    ' === Column C changes: Create H column dropdown ===
    If Target.Column = 3 And Target.Row >= 7 Then
        Dim cell As Range
        For Each cell In Target
@@ -29,7 +28,7 @@ Private Sub Worksheet_Change(ByVal Target As Range)
        Next
    End If

-    ' === Column D changes: Fill E column ===
+    ' === Column H changes: Fill E column ===
    If Target.Column = 8 And Target.Row >= 7 Then
        Dim cellH As Range
        For Each cellH In Target
@@ -71,10 +70,12 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
    Dim endCol As String: endCol = sheetConf("EndCol")
    Dim errorCol As String: errorCol = sheetConf("ErrorCol")

-    ' clear C~I columns background color
+    ' clear C~H columns background color
    Dim clearRange As Range: Set clearRange = ws.Range(ws.Cells(rowNum, startCol), ws.Cells(rowNum, endCol))
    clearRange.Interior.Color = vbWhite

+    Dim checkResult As Boolean: checkResult = False
+
    ' C column check
    checkResult = CheckRequired(ws, rowNum, 3, errorCol)
    If checkResult = False Then Exit Sub
--- a/通勤手当テンプレート20260525.xlsm
+++ b/通勤手当テンプレート20260525.xlsm