UPDSV7-1081 【製造】諸手当一括取込 追加対応 通勤定期券対応

src/sh/tuk/init_module/ThisWorkbook.cls

@@ -0,0 +1,118 @@
+Option Explicit
+
+' Author:
+' Date:
+
+Private Sub Workbook_Open()
+
+    Dim ws As Worksheet
+
+    Application.ScreenUpdating = False
+    Application.Calculation = xlCalculationManual
+    Application.EnableEvents = False
+    Application.DisplayAlerts = False
+    Application.StatusBar = False
+
+    For Each ws In ThisWorkbook.Worksheets
+        ResizeShapes ws
+        PositionShapesInRow ws, "B3"
+    Next ws
+
+    Application.ScreenUpdating = True
+    Application.Calculation = xlCalculationAutomatic
+    Application.EnableEvents = True
+    Application.DisplayAlerts = True
+    Application.StatusBar = True
+
+End Sub
+
+' Description:
+'   Resizes shapes by name category:
+'     load / filter / fit / sort -> square 23.95 x 23.95
+'     output / input / check -> horizontal button 85.04 x 22.68
+' Parameters:
+'   ws: Target worksheet
+' Author:
+'   Date:
+
+Private Sub ResizeShapes(ws As Worksheet)
+
+    Dim shp As Shape
+
+    For Each shp In ws.Shapes
+        If shp.name = "load" Or shp.name = "filter" Or shp.name = "fit" Or shp.name = "sort" Then
+            shp.LockAspectRatio = msoFalse
+            shp.Height = 23.95
+            shp.Width = 23.95
+        ElseIf shp.name = "output" Or shp.name = "input" Or shp.name = "check" Then
+            shp.LockAspectRatio = msoFalse
+            shp.Width = 85.0393700787
+            shp.Height = 22.6771653543
+        ElseIf shp.name = "confirm_no" Or shp.name = "confirm_yes" Then
+            shp.LockAspectRatio = msoFalse
+            shp.Height = 22.6771653543
+            shp.Width = 56.68
+        End If
+    Next shp
+
+End Sub
+
+' Description:
+'   Aligns and spaces shapes horizontally starting from a reference cell.
+'   The leftmost existing shape in the given order aligns to the ref cell's left edge.
+'   All shapes keep their original Y (vertical) position.
+'   Subsequent shapes are placed at (shape_icon_size / 2) intervals.
+' Parameters:
+'   ws: Target worksheet
+'   refCellAddr: Reference cell address (e.g. "B3")
+' Author:
+'   Date:
+
+Private Sub PositionShapesInRow(ws As Worksheet, refCellAddr As String)
+
+    Const SHAPE_ORDER As String = "input,check,output,sort,filter,fit,load,confirm_no,confirm_yes"
+    Const GAP As Double = 11.975
+
+    Dim shapeOrder() As String
+    shapeOrder = Split(SHAPE_ORDER, ",")
+
+    Dim refCell As Range
+    Set refCell = ws.Range(refCellAddr)
+    Dim refLeft As Double
+    refLeft = refCell.Left
+
+    Dim baseY As Double
+    baseY = 0
+
+    Dim shapeName As Variant
+    Dim targetShape As Shape
+    Dim prevShape As Shape
+    Dim isFirst As Boolean
+    Dim i As Long
+
+    isFirst = True
+
+    For i = LBound(shapeOrder) To UBound(shapeOrder)
+        shapeName = shapeOrder(i)
+
+        Set targetShape = Nothing
+        On Error Resume Next
+        Set targetShape = ws.Shapes(CStr(shapeName))
+        On Error GoTo 0
+
+        If targetShape Is Nothing Then GoTo NextShape
+
+        If isFirst Then
+            targetShape.Left = refLeft
+            baseY = targetShape.Top
+            isFirst = False
+        Else
+            targetShape.Left = prevShape.Left + prevShape.Width + GAP
+            targetShape.Top = baseY
+        End If
+
+        Set prevShape = targetShape
+NextShape:
+    Next i
+
+End Sub

src/sh/tuk/module/Common_Button.bas

@@ -196,7 +196,18 @@ Public Sub Validation_Button()
     End If
 
     Do_Fit_Internal ws
+
+    ' Clear previous error marks before validation
+    Dim lastRow As Long: lastRow = GetLastDataRowInRange(ws)
+    Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
+    Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName)
+    Dim errCol As Long: errCol = ColNum(CStr(sheetConf("ErrorCol")))
+    Dim endCol As Long: endCol = ColNum(CStr(sheetConf("EndCol")))
+    ws.Range(ws.Cells(lastRow + 1, errCol), ws.Cells(1048576, errCol)).ClearContents
+    ws.Range(ws.Cells(lastRow + 1, errCol), ws.Cells(1048576, endCol)).Interior.Color = RGB(255, 255, 255)
+
     Application.EnableEvents = True
+    Do_Fit_Internal ws
     Exit Sub
 
 ErrorHandler:

src/sh/tuk/module/Common_Global_Cache.bas

@@ -21,6 +21,7 @@ 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 Const O1_BLOCK_SIZE As Long = 100
 
 
 Private sheetConfDict As Object
@@ -344,13 +345,13 @@ Private Sub RefreshSheetDict()
     ' C1
     Set sheetConf = CreateObject("Scripting.Dictionary")
     sheetConf("StartCol") = "C"
-    sheetConf("EndCol") = "BC"
+    sheetConf("EndCol") = "BG"
     sheetConf("ErrorCol") = "B"
     sheetConf("StartRow") = 8
     sheetConf("HeaderRow") = 6
     sheetConf("CSV_Encoding") = "shift_jis"
     sheetConf("HasHeader") = True
-    sheetConf("ExpectedColumnCount") = 41
+    sheetConf("ExpectedColumnCount") = 45
     sheetConf("HeaderColumns") = Array("C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "W", "X", "Y", "Z", "AA", "AE", "AF", "AG", "AH", "AI", "AM", "AN", "AO", "AP", "AQ", "AU", "AV", "AW", "AX", "AY", "AZ", "BA", "BB", "BC", "BD", "BE", "BF", "BG")
     sheetConf("AlwaysQuote") = False
     sheetConf("FilterRow") = 7
@@ -751,6 +752,101 @@ Public Sub WriteCachesSheet(ByVal cacheName As String)
     FormulaCache(cacheName) = formulaStr
 End Sub
 
+' ============================================================
+' O1 Address Dropdown Cache Writers
+' Per-row address1/address2 unique values are written to Caches sheet
+' so xlValidateList Formula1 references Text-formatted cells.
+' This bypasses Excel's date/number auto-coercion that happens when
+' comma-separated Formula1 strings contain values like "2623-41".
+'
+' Layout:
+'   Caches column N (14) = O1 address1 data
+'   Caches column O (15) = O1 address2 data
+'   Block per C1 row: rows (rowNum-1)*O1_BLOCK_SIZE+1 to rowNum*O1_BLOCK_SIZE
+' ============================================================
+
+' Write O1 address1 unique values for cshainno into Caches col N block.
+' Returns Formula1 like "=Caches!$N$X:$N$Y", or "" if no data.
+Public Function WriteCachesSheetForO1Address1(ByVal cshainno As String, ByVal rowNum As Long) As String
+    Dim wsCache As Worksheet
+    Set wsCache = ThisWorkbook.Sheets("Caches")
+    If wsCache Is Nothing Then
+        Set wsCache = ThisWorkbook.Sheets.Add
+        wsCache.Name = "Caches"
+        wsCache.Visible = xlVeryHidden
+    End If
+
+    Const COL As Long = 14  ' N column
+    Dim blockStart As Long: blockStart = (rowNum - 1) * O1_BLOCK_SIZE + 1
+    Dim blockEnd As Long: blockEnd = blockStart + O1_BLOCK_SIZE - 1
+
+    ' Clear block to prevent stale data leakage across rows
+    wsCache.Range(wsCache.Cells(blockStart, COL), wsCache.Cells(blockEnd, COL)).ClearContents
+
+    Dim o1Cache As Object: Set o1Cache = GetCache(CACHE_O1)
+    If o1Cache Is Nothing Then Exit Function
+    If Not o1Cache.Exists(cshainno) Then Exit Function
+
+    Dim innerDict As Object: Set innerDict = o1Cache(cshainno)
+
+    Dim idx As Long: idx = 0
+    Dim eKey As Variant
+    For Each eKey In innerDict.Keys
+        idx = idx + 1
+        With wsCache.Cells(blockStart + idx, COL)
+            .NumberFormat = "@"
+            .Value = CStr(eKey)
+        End With
+        If idx >= O1_BLOCK_SIZE Then Exit For
+    Next eKey
+
+    If idx = 0 Then Exit Function
+
+    WriteCachesSheetForO1Address1 = "=Caches!$N$" & (blockStart + 1) & ":$N$" & (blockStart + idx)
+End Function
+
+' Write O1 address2 unique values for (cshainno, address1) into Caches col O block.
+' Returns Formula1 like "=Caches!$O$X:$O$Y", or "" if no data.
+Public Function WriteCachesSheetForO1Address2(ByVal cshainno As String, ByVal address1 As String, ByVal rowNum As Long) As String
+    Dim wsCache As Worksheet
+    Set wsCache = ThisWorkbook.Sheets("Caches")
+    If wsCache Is Nothing Then
+        Set wsCache = ThisWorkbook.Sheets.Add
+        wsCache.Name = "Caches"
+        wsCache.Visible = xlVeryHidden
+    End If
+
+    Const COL As Long = 15  ' O column
+    Dim blockStart As Long: blockStart = (rowNum - 1) * O1_BLOCK_SIZE + 1
+    Dim blockEnd As Long: blockEnd = blockStart + O1_BLOCK_SIZE - 1
+
+    wsCache.Range(wsCache.Cells(blockStart, COL), wsCache.Cells(blockEnd, COL)).ClearContents
+
+    Dim o1Cache As Object: Set o1Cache = GetCache(CACHE_O1)
+    If o1Cache Is Nothing Then Exit Function
+    If Not o1Cache.Exists(cshainno) Then Exit Function
+
+    Dim innerDict As Object: Set innerDict = o1Cache(cshainno)
+    If Not innerDict.Exists(address1) Then Exit Function
+
+    Dim addr2Dict As Object: Set addr2Dict = innerDict(address1)
+
+    Dim idx As Long: idx = 0
+    Dim addr2Key As Variant
+    For Each addr2Key In addr2Dict.Keys
+        idx = idx + 1
+        With wsCache.Cells(blockStart + idx, COL)
+            .NumberFormat = "@"
+            .Value = CStr(addr2Key)
+        End With
+        If idx >= O1_BLOCK_SIZE Then Exit For
+    Next addr2Key
+
+    If idx = 0 Then Exit Function
+
+    WriteCachesSheetForO1Address2 = "=Caches!$O$" & (blockStart + 1) & ":$O$" & (blockStart + idx)
+End Function
+
 Public Function GetValidationFormula(ByVal cacheName As String) As String
     If FormulaCache Is Nothing Then Set FormulaCache = CreateObject("Scripting.Dictionary")
     If FormulaCache.Exists(cacheName) Then

src/sh/tuk/sheet/C1.cls

@@ -56,7 +56,7 @@ Private Function KUKAN_START_DAY_COLS() As Variant
 End Function
 
 Private Function DATE_COLS() As Variant
-    DATE_COLS = Array(4, 5, 6, 26, 34, 42, 50, 56, 59)  ' D, E, F, Z, AH, AP, AX, BC, BF
+    DATE_COLS = Array(4, 5, 6, 26, 34, 42, 50, 55, 58)  ' D, E, F, Z, AH, AP, AX, BC, BF
 End Function
 
 Private Function NUMBER_COLS() As Variant
@@ -89,15 +89,7 @@ Private Sub Worksheet_Change(ByVal Target As Range)
     With Me
         Set watchArea = Union( _
             .Columns("C"), _
-            .Columns("D"), _
-            .Columns("E"), _
-            .Columns("F"), _
-            .Columns("G"), _
-            .Columns("I"), _
-            .Columns("S:X"), _
-            .Columns("AA:AF"), _
-            .Columns("AI:AN"), _
-            .Columns("AQ:AV") _
+            .Columns("D:BG") _
         )
     End With
     Dim intersectRng As Range: Set intersectRng = Application.Intersect(Target, watchArea)
@@ -149,6 +141,9 @@ Private Sub Worksheet_Change(ByVal Target As Range)
     If Target.Column = 9 Then
         Dim cellI As Range
         For Each cellI In Target
+            ' Always clear address2 (content + dropdown) when address1 changes;
+            ' new dropdown will be rebuilt by BuildAddress2Dropdown below
+            Call ClearAddress2(cellI.Row)
             Call BuildAddress2Dropdown(cellI.Row, Trim(Me.Cells(cellI.Row, CSHAINNO_COL).Value))
         Next
     End If
@@ -278,6 +273,240 @@ Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
     End If
 End Sub
 
+
+' Validation logic
+Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As Long)
+    On Error GoTo ErrHandler
+
+    Dim engine As ValidationRuleEngine: Set engine = New ValidationRuleEngine
+        With engine
+            ' Required columns
+            .AddRequired "C"
+            .AddRequired "D"
+            .AddRequired "E"
+            .AddRequired "F"
+            .AddRequired "G"
+            .AddRequired "L"
+            .AddRequired "M"
+            .AddRequired "N"
+            .AddRequired "BA"
+
+            ' Date columns
+            .AddDate "D"
+            .AddDate "E"
+            .AddDate "F"
+            .AddDate "Z"
+            .AddDate "AH"
+            .AddDate "AP"
+            .AddDate "AX"
+            .AddDate "BC"
+            .AddDate "BF"
+
+            ' Number columns (numeric check only, no digit limit)
+            .AddNumber "L", 2, 0
+            .AddNumber "P", 4, 1
+            .AddNumber "Q", 6, 0
+            .AddNumber "R", 6, 0
+
+            ' G column o3Cache
+            .AddCodeSelect "G", CACHE_O3
+
+            ' M column oufukuList
+            .AddCodeSelect "M", "oufukuList"
+
+            ' N column koutaiList
+            .AddCodeSelect "N", "koutaiList"
+        End With
+
+    Dim result As ValidationResult: Set result = engine.ValidateRow(ws, rowNum, lastDataRow)
+    If result.ErrorCode <> "" Then Exit Sub
+
+    ' === Special cases (cross-column / cross-cache) ===
+    Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
+    Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName)
+    Dim errorCol As String: errorCol = sheetConf("ErrorCol")
+    Dim errorCell As Range: Set errorCell = ws.Cells(rowNum, errorCol)
+
+    ' I/J address validation
+    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(ws.Cells(rowNum, ColI).Value)
+    Dim address2 As String: address2 = Trim(ws.Cells(rowNum, ColJ).Value)
+    If address1 = "" Then
+        If address2 <> "" Then
+            errorCell.Value = ColJ & " column is invalid"
+            ws.Range(ColJ & rowNum).Interior.Color = RGB(255, 0, 0)
+            Exit Sub
+        End If
+    Else
+        Dim empNo As String: empNo = Trim(ws.Cells(rowNum, 3).Value)
+        If Not o1Cache.Exists(empNo) Then
+            errorCell.Value = ColI & " column is invalid"
+            ws.Range(ColI & rowNum).Interior.Color = RGB(255, 0, 0)
+            Exit Sub
+        End If
+        Dim innerDict As Object: Set innerDict = o1Cache(empNo)
+        If Not innerDict.Exists(address1) Then
+            errorCell.Value = ColI & " column is invalid"
+            ws.Range(ColI & rowNum).Interior.Color = RGB(255, 0, 0)
+            Exit Sub
+        End If
+        Dim addr2Dict As Object: Set addr2Dict = innerDict(address1)
+        If Not addr2Dict.Exists(address2) Then
+            errorCell.Value = ColJ & " column is invalid"
+            ws.Range(ColJ & rowNum).Interior.Color = RGB(255, 0, 0)
+            Exit Sub
+        End If
+    End If
+
+    ' K column (readonly)
+    Dim ColK As String: ColK = "K"
+    If Trim(ws.Cells(rowNum, ColK).Value) <> "" Then
+        errorCell.Value = ColK & " column can not be input"
+        ws.Range(ColK & rowNum).Interior.Color = RGB(255, 0, 0)
+        Exit Sub
+    End If
+
+    ' KUKAN block (kept as-is)
+    Dim m1Cache As Object: Set m1Cache = GetCache("M1")
+    Dim m2Cache As Object: Set m2Cache = GetCache("M2")
+    Dim kukanCols As Variant
+    kukanCols = Array(KUKAN_TRANSPORT_COLS, KUKAN_STATION_COLS, KUKAN_ARRIVAL_COLS, KUKAN_TICKET_COLS, KUKAN_CODE2_COLS, KUKAN_START_DAY_COLS)
+
+    Dim kukanIdx As Long
+    For kukanIdx = LBound(KUKAN_CODE_COLS) To UBound(KUKAN_CODE_COLS)
+        Dim kukanCol As Long: kukanCol = KUKAN_CODE_COLS(kukanIdx)
+        Dim kukanCode As String: kukanCode = Trim(ws.Cells(rowNum, kukanCol).Value)
+        Dim kukanLetter As String: kukanLetter = Split(ws.Cells(1, kukanCol).Address, "$")(1)
+
+        If kukanCode <> "" Then
+            If Not m1Cache.Exists(kukanCode) Then
+                errorCell.Value = kukanLetter & " column does not exist"
+                ws.Range(kukanLetter & rowNum).Interior.Color = RGB(255, 0, 0)
+                Exit Sub
+            End If
+
+            Dim ticketCol As Long: ticketCol = KUKAN_TICKET_COLS(kukanIdx)
+            Dim code2Col As Long: code2Col = KUKAN_CODE2_COLS(kukanIdx)
+            Dim teikiCol As Long: teikiCol = KUKAN_TEIKI_COLS(kukanIdx)
+            Dim ticketVal As String: ticketVal = GetCode(Trim(ws.Cells(rowNum, ticketCol).Value))
+            Dim code2Val As String: code2Val = GetCode(Trim(ws.Cells(rowNum, code2Col).Value))
+            Dim ticketLetter As String: ticketLetter = Split(ws.Cells(1, ticketCol).Address, "$")(1)
+            Dim code2Letter As String: code2Letter = Split(ws.Cells(1, code2Col).Address, "$")(1)
+
+            If ticketVal = "" Then
+                errorCell.Value = ticketLetter & " column must be input"
+                ws.Range(ticketLetter & rowNum).Interior.Color = RGB(255, 0, 0)
+                Exit Sub
+            End If
+
+            If ticketVal = "0" Then
+                If code2Val <> "" Then
+                    errorCell.Value = code2Letter & " column is invalid"
+                    ws.Range(code2Letter & rowNum).Interior.Color = RGB(255, 0, 0)
+                    Exit Sub
+                End If
+            Else
+                Dim kanshuDict As Object
+                If m2Cache.Exists(kukanCode) Then
+                    Set kanshuDict = m2Cache(kukanCode)
+                    If Not kanshuDict.Exists(ticketVal) Then
+                        errorCell.Value = ticketLetter & " column is invalid"
+                        ws.Range(ticketLetter & rowNum).Interior.Color = RGB(255, 0, 0)
+                        Exit Sub
+                    End If
+
+                    If code2Val = "" Then
+                        errorCell.Value = code2Letter & " column should be input"
+                        ws.Range(code2Letter & rowNum).Interior.Color = RGB(255, 0, 0)
+                        Exit Sub
+                    Else
+                        Dim codeDict As Object: Set codeDict = kanshuDict(ticketVal)
+                        If Not codeDict.Exists(code2Val) Then
+                            errorCell.Value = code2Letter & " column is invalid"
+                            ws.Range(code2Letter & rowNum).Interior.Color = RGB(255, 0, 0)
+                            Exit Sub
+                        Else
+                            Dim teikiValue As String: teikiValue = Trim(ws.Cells(rowNum, teikiCol).Value)
+                            If ticketVal = "1" And teikiValue = "" Then
+                                Dim teikiLetter As String: teikiLetter = ColLetter(teikiCol)
+                                errorCell.Value = teikiLetter & " column is required"
+                                ws.Range(teikiLetter & rowNum).Interior.Color = RGB(255, 0, 0)
+                                Exit Sub
+                            End If
+                        End If
+                    End If
+                End If
+            End If
+        Else
+            Dim colGroup As Variant
+            For Each colGroup In kukanCols
+                Dim checkCol As Long: checkCol = colGroup(kukanIdx)
+                Dim checkVal As String: checkVal = Trim(ws.Cells(rowNum, checkCol).Value)
+                If checkVal <> "" Then
+                    Dim checkLetter As String: checkLetter = Split(ws.Cells(1, checkCol).Address, "$")(1)
+                    errorCell.Value = checkLetter & " column requires " & kukanLetter & " column"
+                    ws.Range(checkLetter & rowNum).Interior.Color = RGB(255, 0, 0)
+                    Exit Sub
+                End If
+            Next colGroup
+        End If
+    Next kukanIdx
+
+    ' KUKAN_CODE_COLS duplicate check
+    Dim kukanCodes As Object: Set kukanCodes = CreateObject("Scripting.Dictionary")
+    For kukanIdx = LBound(KUKAN_CODE_COLS) To UBound(KUKAN_CODE_COLS)
+        kukanCol = KUKAN_CODE_COLS(kukanIdx)
+        kukanCode = Trim(ws.Cells(rowNum, kukanCol).Value)
+        If kukanCode <> "" Then
+            If kukanCodes.Exists(kukanCode) Then
+                kukanLetter = Split(ws.Cells(1, kukanCol).Address, "$")(1)
+                errorCell.Value = GetErrorMsg("E003", kukanLetter & rowNum)
+                ws.Range(kukanLetter & rowNum).Interior.Color = RGB(255, 0, 0)
+                Exit Sub
+            Else
+                kukanCodes.Add kukanCode, True
+            End If
+        End If
+    Next kukanIdx
+
+    ' H/BB/BC (always runs, independent of special cases)
+    Dim linkCellValue As String: linkCellValue = ws.Cells(3, "H").Value
+    Dim ColBF As String: ColBF = "BF"
+    Dim ColBG As String: ColBG = "BG"
+    Dim valBF As String: valBF = Trim(ws.Cells(rowNum, ColBF).Value)
+    Dim valBG As String: valBG = Trim(ws.Cells(rowNum, ColBG).Value)
+    If linkCellValue = "1" Then
+        If valBF <> "" Then
+            errorCell.Value = GetErrorMsg("E005", ColBF & rowNum)
+            ws.Range(ColBF & rowNum).Interior.Color = RGB(255, 0, 0)
+            Exit Sub
+        End If
+        If valBG <> "" Then
+            errorCell.Value = GetErrorMsg("E005", ColBG & rowNum)
+            ws.Range(ColBG & rowNum).Interior.Color = RGB(255, 0, 0)
+            Exit Sub
+        End If
+    ElseIf linkCellValue = "2" Then
+        If valBF = "" Then
+            errorCell.Value = GetErrorMsg("E002", ColBF & rowNum)
+            ws.Range(ColBF & rowNum).Interior.Color = RGB(255, 0, 0)
+            Exit Sub
+        End If
+        If valBG = "" Then
+            errorCell.Value = GetErrorMsg("E002", ColBG & rowNum)
+            ws.Range(ColBG & rowNum).Interior.Color = RGB(255, 0, 0)
+            Exit Sub
+        End If
+    End If
+
+    Exit Sub
+
+ErrHandler:
+    SetLastErrorMsg Err.Description
+End Sub
+
 Private Sub Refresh(ws As Worksheet, ByVal startRow As Long, ByVal lastDataRow As Long)
     Dim z1Cache As Object: Set z1Cache = GetCache(CACHE_Z1)
     
@@ -437,39 +666,27 @@ 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(CACHE_O1)
-    ' Build dropdown list from O1 cache: get all E values for the C
-    Dim dropdownList As String
-    If o1Cache.Exists(cshainno) Then
-        Dim innerDict As Object
-        Set innerDict = o1Cache(cshainno)
-        Dim eKey As Variant
-        For Each eKey In innerDict.Keys
-            If dropdownList = "" Then
-                dropdownList = eKey
-            Else
-                dropdownList = dropdownList & "," & eKey
-            End If
-        Next eKey
-    End If
+    ' Write address1 unique values to Caches sheet as Text, then reference that range.
+    ' This bypasses xlValidateList comma-string parsing that auto-coerces
+    ' date-like values (e.g. "2623-41") into dates.
+    Dim formula As String: formula = WriteCachesSheetForO1Address1(cshainno, rowNum)
+    If formula = "" Then Exit Sub
 
-    ' Create dropdown for I column address1
-    If dropdownList <> "" Then
-        With Me.Range("I" & rowNum).Validation
-            .Delete
-            .Add Type:=xlValidateList, Formula1:=dropdownList
-            .IgnoreBlank = True
-            .InCellDropdown = True
-            .InputTitle = ""
-            .InputMessage = ""
-        End With
-    End If
+    With Me.Range("I" & rowNum).Validation
+        .Delete
+        .Add Type:=xlValidateList, Formula1:=formula
+        .IgnoreBlank = True
+        .InCellDropdown = True
+        .InputTitle = ""
+        .InputMessage = ""
+    End With
 End Sub
 
 Private Sub ReFillAddress1(ByVal rowNum As Long, ByVal cshainno As String)
     Dim o1Cache As Object: Set o1Cache = GetCache(CACHE_O1)
     If Not o1Cache.Exists(cshainno) Then
         Me.Cells(rowNum, ADDRESS1_COL).Value = ""
+        Call ClearAddress2(rowNum)
         Exit Sub
     End If
 
@@ -484,54 +701,30 @@ Private Sub ReFillAddress1(ByVal rowNum As Long, ByVal cshainno As String)
     Dim originalValue As String: originalValue = Trim(Me.Cells(rowNum, ADDRESS1_COL).Value)
     If originalValue = "" Then Exit Sub
 
-    ' Clear if value not found in O1 cache keys
+    ' Clear if value not found in O1 cache keys (cascade clear address2 too)
     If Not innerDict.Exists(originalValue) Then
         Me.Cells(rowNum, ADDRESS1_COL).Value = ""
+        Call ClearAddress2(rowNum)
     End If
 End Sub
 
 ' triggered by address1 select O1 cache
 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(CACHE_O1)
     Dim address1 As String: address1 = Trim(Me.Cells(rowNum, ADDRESS1_COL).Value)
-    If cshainno = "" OR address1 = "" Then
-        Exit Sub
-    End If
+    If cshainno = "" OR address1 = "" Then Exit Sub
 
-    ' Build dropdown list from O1 cache
-    Dim dropdownList As String
-    If o1Cache.Exists(cshainno) Then
-        Dim innerDict As Object
-        Set innerDict = o1Cache(cshainno)
+    ' Write address2 unique values to Caches sheet as Text, then reference that range.
+    Dim formula As String: formula = WriteCachesSheetForO1Address2(cshainno, address1, rowNum)
+    If formula = "" Then Exit Sub
 
-        If innerDict.Exists(address1) Then
-          Dim addr2Dict As Object
-          Set addr2Dict = innerDict(address1)
-
-            Dim addr2Key As Variant
-            For Each addr2Key In addr2Dict.Keys
-                If dropdownList = "" Then
-                    dropdownList = addr2Key
-                Else
-                    dropdownList = dropdownList & "," & addr2Key
-                End If
-            Next addr2Key
-        End If
-    End If
-    
-    ' Create dropdown for J column 
-    If dropdownList <> "" Then
-        With Me.Range("J" & rowNum).Validation
-            .Delete
-            .Add Type:=xlValidateList, Formula1:=dropdownList
-            .IgnoreBlank = True
-            .InCellDropdown = True
-            .InputTitle = ""
-            .InputMessage = ""
-        End With
-    End If
+    With Me.Range("J" & rowNum).Validation
+        .Delete
+        .Add Type:=xlValidateList, Formula1:=formula
+        .IgnoreBlank = True
+        .InCellDropdown = True
+        .InputTitle = ""
+        .InputMessage = ""
+    End With
 End Sub
 
 Private Sub ReFillAddress2(ByVal rowNum As Long, ByVal cshainno As String)
@@ -560,7 +753,17 @@ Private Sub ReFillAddress2(ByVal rowNum As Long, ByVal cshainno As String)
         Exit Sub
     End If
 
-    Me.Cells(rowNum, ADDRESS2_COL).Value = ""
+    ' Only clear if current value is not in the cache (matches ReFillAddress1 pattern)
+    Dim originalValue As String: originalValue = Trim(Me.Cells(rowNum, ADDRESS2_COL).Value)
+    If originalValue <> "" And Not addr2Dict.Exists(originalValue) Then
+        Me.Cells(rowNum, ADDRESS2_COL).Value = ""
+    End If
+End Sub
+
+' Clear address2 cell content and validation (removes dropdown arrow too)
+Private Sub ClearAddress2(ByVal rowNum As Long)
+    Me.Cells(rowNum, ADDRESS2_COL).ClearContents
+    Me.Range("J" & rowNum).Validation.Delete
 End Sub
 
 ' Create station from dropdown from M1_KukanD cache
@@ -772,239 +975,6 @@ Private Sub ClearRowData(ByVal rowNum As Long)
     Me.Range(Me.Cells(rowNum, startCol), Me.Cells(rowNum, endCol)).Interior.Color = vbWhite
 End Sub
 
-' Validation logic
-Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As Long)
-    On Error GoTo ErrHandler
-
-    Dim engine As ValidationRuleEngine: Set engine = New ValidationRuleEngine
-        With engine
-            ' Required columns
-            .AddRequired "C"
-            .AddRequired "D"
-            .AddRequired "E"
-            .AddRequired "F"
-            .AddRequired "G"
-            .AddRequired "L"
-            .AddRequired "M"
-            .AddRequired "N"
-            .AddRequired "BA"
-
-            ' Date columns
-            .AddDate "D"
-            .AddDate "E"
-            .AddDate "F"
-            .AddDate "Z"
-            .AddDate "AH"
-            .AddDate "AP"
-            .AddDate "AX"
-            .AddDate "BC"
-            .AddDate "BF"
-
-            ' Number columns (numeric check only, no digit limit)
-            .AddNumber "L", 2
-            .AddNumber "P", 4, 1
-            .AddNumber "Q", 6
-            .AddNumber "R", 6
-
-            ' G column o3Cache
-            .AddCodeSelect "G", CACHE_O3
-
-            ' M column oufukuList
-            .AddCodeSelect "M", "oufukuList"
-
-            ' N column koutaiList
-            .AddCodeSelect "N", "koutaiList"
-        End With
-
-    Dim result As ValidationResult: Set result = engine.ValidateRow(ws, rowNum, lastDataRow)
-    If result.ErrorCode <> "" Then Exit Sub
-
-    ' === Special cases (cross-column / cross-cache) ===
-    Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
-    Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName)
-    Dim errorCol As String: errorCol = sheetConf("ErrorCol")
-    Dim errorCell As Range: Set errorCell = ws.Cells(rowNum, errorCol)
-
-    ' I/J address validation
-    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(ws.Cells(rowNum, ColI).Value)
-    Dim address2 As String: address2 = Trim(ws.Cells(rowNum, ColJ).Value)
-    If address1 = "" Then
-        If address2 <> "" Then
-            errorCell.Value = ColJ & " column is invalid"
-            ws.Range(ColJ & rowNum).Interior.Color = RGB(255, 0, 0)
-            Exit Sub
-        End If
-    Else
-        Dim empNo As String: empNo = Trim(ws.Cells(rowNum, 3).Value)
-        If Not o1Cache.Exists(empNo) Then
-            errorCell.Value = ColI & " column is invalid"
-            ws.Range(ColI & rowNum).Interior.Color = RGB(255, 0, 0)
-            Exit Sub
-        End If
-        Dim innerDict As Object: Set innerDict = o1Cache(empNo)
-        If Not innerDict.Exists(address1) Then
-            errorCell.Value = ColI & " column is invalid"
-            ws.Range(ColI & rowNum).Interior.Color = RGB(255, 0, 0)
-            Exit Sub
-        End If
-        Dim addr2Dict As Object: Set addr2Dict = innerDict(address1)
-        If Not addr2Dict.Exists(address2) Then
-            errorCell.Value = ColJ & " column is invalid"
-            ws.Range(ColJ & rowNum).Interior.Color = RGB(255, 0, 0)
-            Exit Sub
-        End If
-    End If
-
-    ' K column (readonly)
-    Dim ColK As String: ColK = "K"
-    If Trim(ws.Cells(rowNum, ColK).Value) <> "" Then
-        errorCell.Value = ColK & " column can not be input"
-        ws.Range(ColK & rowNum).Interior.Color = RGB(255, 0, 0)
-        Exit Sub
-    End If
-
-    ' KUKAN block (kept as-is)
-    Dim m1Cache As Object: Set m1Cache = GetCache("M1")
-    Dim m2Cache As Object: Set m2Cache = GetCache("M2")
-    Dim kukanCols As Variant
-    kukanCols = Array(KUKAN_TRANSPORT_COLS, KUKAN_STATION_COLS, KUKAN_ARRIVAL_COLS, KUKAN_TICKET_COLS, KUKAN_CODE2_COLS, KUKAN_START_DAY_COLS)
-
-    Dim kukanIdx As Long
-    For kukanIdx = LBound(KUKAN_CODE_COLS) To UBound(KUKAN_CODE_COLS)
-        Dim kukanCol As Long: kukanCol = KUKAN_CODE_COLS(kukanIdx)
-        Dim kukanCode As String: kukanCode = Trim(ws.Cells(rowNum, kukanCol).Value)
-        Dim kukanLetter As String: kukanLetter = Split(ws.Cells(1, kukanCol).Address, "$")(1)
-
-        If kukanCode <> "" Then
-            If Not m1Cache.Exists(kukanCode) Then
-                errorCell.Value = kukanLetter & " column does not exist"
-                ws.Range(kukanLetter & rowNum).Interior.Color = RGB(255, 0, 0)
-                Exit Sub
-            End If
-
-            Dim ticketCol As Long: ticketCol = KUKAN_TICKET_COLS(kukanIdx)
-            Dim code2Col As Long: code2Col = KUKAN_CODE2_COLS(kukanIdx)
-            Dim teikiCol As Long: teikiCol = KUKAN_TEIKI_COLS(kukanIdx)
-            Dim ticketVal As String: ticketVal = GetCode(Trim(ws.Cells(rowNum, ticketCol).Value))
-            Dim code2Val As String: code2Val = GetCode(Trim(ws.Cells(rowNum, code2Col).Value))
-            Dim ticketLetter As String: ticketLetter = Split(ws.Cells(1, ticketCol).Address, "$")(1)
-            Dim code2Letter As String: code2Letter = Split(ws.Cells(1, code2Col).Address, "$")(1)
-
-            If ticketVal = "" Then
-                errorCell.Value = ticketLetter & " column must be input"
-                ws.Range(ticketLetter & rowNum).Interior.Color = RGB(255, 0, 0)
-                Exit Sub
-            End If
-
-            If ticketVal = "0" Then
-                If code2Val <> "" Then
-                    errorCell.Value = code2Letter & " column is invalid"
-                    ws.Range(code2Letter & rowNum).Interior.Color = RGB(255, 0, 0)
-                    Exit Sub
-                End If
-            Else
-                Dim kanshuDict As Object
-                If m2Cache.Exists(kukanCode) Then
-                    Set kanshuDict = m2Cache(kukanCode)
-                    If Not kanshuDict.Exists(ticketVal) Then
-                        errorCell.Value = ticketLetter & " column is invalid"
-                        ws.Range(ticketLetter & rowNum).Interior.Color = RGB(255, 0, 0)
-                        Exit Sub
-                    End If
-
-                    If code2Val = "" Then
-                        errorCell.Value = code2Letter & " column should be input"
-                        ws.Range(code2Letter & rowNum).Interior.Color = RGB(255, 0, 0)
-                        Exit Sub
-                    Else
-                        Dim codeDict As Object: Set codeDict = kanshuDict(ticketVal)
-                        If Not codeDict.Exists(code2Val) Then
-                            errorCell.Value = code2Letter & " column is invalid"
-                            ws.Range(code2Letter & rowNum).Interior.Color = RGB(255, 0, 0)
-                            Exit Sub
-                        Else
-                            Dim teikiValue As String: teikiValue = Trim(ws.Cells(rowNum, teikiCol).Value)
-                            If ticketVal = "1" And teikiValue = "" Then
-                                Dim teikiLetter As String: teikiLetter = ColLetter(teikiCol)
-                                errorCell.Value = teikiLetter & " column is required"
-                                ws.Range(teikiLetter & rowNum).Interior.Color = RGB(255, 0, 0)
-                                Exit Sub
-                            End If
-                        End If
-                    End If
-                End If
-            End If
-        Else
-            Dim colGroup As Variant
-            For Each colGroup In kukanCols
-                Dim checkCol As Long: checkCol = colGroup(kukanIdx)
-                Dim checkVal As String: checkVal = Trim(ws.Cells(rowNum, checkCol).Value)
-                If checkVal <> "" Then
-                    Dim checkLetter As String: checkLetter = Split(ws.Cells(1, checkCol).Address, "$")(1)
-                    errorCell.Value = checkLetter & " column requires " & kukanLetter & " column"
-                    ws.Range(checkLetter & rowNum).Interior.Color = RGB(255, 0, 0)
-                    Exit Sub
-                End If
-            Next colGroup
-        End If
-    Next kukanIdx
-
-    ' KUKAN_CODE_COLS duplicate check
-    Dim kukanCodes As Object: Set kukanCodes = CreateObject("Scripting.Dictionary")
-    For kukanIdx = LBound(KUKAN_CODE_COLS) To UBound(KUKAN_CODE_COLS)
-        kukanCol = KUKAN_CODE_COLS(kukanIdx)
-        kukanCode = Trim(ws.Cells(rowNum, kukanCol).Value)
-        If kukanCode <> "" Then
-            If kukanCodes.Exists(kukanCode) Then
-                kukanLetter = Split(ws.Cells(1, kukanCol).Address, "$")(1)
-                errorCell.Value = GetErrorMsg("E003", kukanLetter & rowNum)
-                ws.Range(kukanLetter & rowNum).Interior.Color = RGB(255, 0, 0)
-                Exit Sub
-            Else
-                kukanCodes.Add kukanCode, True
-            End If
-        End If
-    Next kukanIdx
-
-    ' H/BB/BC (always runs, independent of special cases)
-    Dim linkCellValue As String: linkCellValue = ws.Cells(3, "H").Value
-    Dim ColBF As String: ColBF = "BF"
-    Dim ColBG As String: ColBG = "BG"
-    Dim valBF As String: valBF = Trim(ws.Cells(rowNum, ColBF).Value)
-    Dim valBG As String: valBG = Trim(ws.Cells(rowNum, ColBG).Value)
-    If linkCellValue = "1" Then
-        If valBF <> "" Then
-            errorCell.Value = GetErrorMsg("E005", ColBF & rowNum)
-            ws.Range(ColBF & rowNum).Interior.Color = RGB(255, 0, 0)
-            Exit Sub
-        End If
-        If valBG <> "" Then
-            errorCell.Value = GetErrorMsg("E005", ColBG & rowNum)
-            ws.Range(ColBG & rowNum).Interior.Color = RGB(255, 0, 0)
-            Exit Sub
-        End If
-    ElseIf linkCellValue = "2" Then
-        If valBF = "" Then
-            errorCell.Value = GetErrorMsg("E002", ColBF & rowNum)
-            ws.Range(ColBF & rowNum).Interior.Color = RGB(255, 0, 0)
-            Exit Sub
-        End If
-        If valBG = "" Then
-            errorCell.Value = GetErrorMsg("E002", ColBG & rowNum)
-            ws.Range(ColBG & rowNum).Interior.Color = RGB(255, 0, 0)
-            Exit Sub
-        End If
-    End If
-
-    Exit Sub
-
-ErrHandler:
-    SetLastErrorMsg Err.Description
-End Sub
-
 ' Create teiki dropdown based on M2 cache
 Private Sub CreateTeikiDropdown(ByVal row As Long, ByVal idx As Long)
     ' Get kukanCode from KUKAN_CODE_COLS

src/sh/tuk/sheet/M1.cls

@@ -141,10 +141,10 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
         .AddRequired "L"
         .AddCodeSelect "K", "renrakuList"
         .AddCodeSelect "L", "tokubetuList"
-        .AddNumber "H", 6,  1
-        .AddNumber "I", 5
-        .AddNumber "J", 6
-        .AddNumber "N"
+        .AddNumber "H", 6, 1
+        .AddNumber "I", 5, 0
+        .AddNumber "J", 6, 0
+        .AddNumber "N", 7, 0
         
     End With
 

src/sh/tuk/sheet/M2.cls

@@ -118,9 +118,9 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
         .AddRequired "K"
         .AddRequired "L"
         .AddRequired "M"
-        .AddNumber "L"
-        .AddNumber "M"
-        .AddNumber "N"
+        .AddNumber "L", 10, 3
+        .AddNumber "M", 7, 0
+        .AddNumber "N", 3, 0
         .AddNumber "O"
         .AddNumber "P"
         .AddNumber "Q"

src/sh/tuk/validation/ValidationRule.cls

@@ -43,6 +43,12 @@ Public Function ValidateRow(ws As Worksheet, rowNum As Long, Optional lastDataRo
             If dateVal <> "" Then
                 If Len(dateVal) <> 10 Or Mid(dateVal, 5, 1) <> "-" Or Mid(dateVal, 8, 1) <> "-" Then
                     result.SetFail ERR_INVALID, ColIndex, rowNum
+                ElseIf Not IsNumeric(Left(dateVal, 4)) Then
+                    result.SetFail ERR_INVALID, ColIndex, rowNum
+                ElseIf Not IsNumeric(Mid(dateVal, 6, 2)) Then
+                    result.SetFail ERR_INVALID, ColIndex, rowNum
+                ElseIf Not IsNumeric(Right(dateVal, 2)) Then
+                    result.SetFail ERR_INVALID, ColIndex, rowNum
                 End If
             End If
 
@@ -65,6 +71,8 @@ Public Function ValidateRow(ws As Worksheet, rowNum As Long, Optional lastDataRo
                     If Left(intPart, 1) = "-" Then intPart = Mid(intPart, 2)
                     If Len(intPart) = 0 Then
                         result.SetFail ERR_NUMDIGITS, ColIndex, rowNum, "Number(" & NumberDigits & ", " & NumberDec & ")"
+                    ElseIf NumberDec = 0 And dotPos > 0 Then
+                        result.SetFail ERR_NUMDIGITS, ColIndex, rowNum, "Number(" & NumberDigits & ", " & NumberDec & ")"
                     ElseIf Len(intPart) > NumberDigits - NumberDec Then
                         result.SetFail ERR_NUMDIGITS, ColIndex, rowNum, "Number(" & NumberDigits & ", " & NumberDec & ")"
                     ElseIf NumberDec > 0 And Len(decPart) > NumberDec Then