diff --git a/src/sh/tuk/module/Common_Global_Cache.bas b/src/sh/tuk/module/Common_Global_Cache.bas index de23a3b..3cadc1a 100644 --- a/src/sh/tuk/module/Common_Global_Cache.bas +++ b/src/sh/tuk/module/Common_Global_Cache.bas @@ -344,13 +344,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 diff --git a/src/sh/tuk/sheet/C1.cls b/src/sh/tuk/sheet/C1.cls index fc86aa6..8731c73 100644 --- a/src/sh/tuk/sheet/C1.cls +++ b/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) @@ -278,6 +270,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 + .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 + Private Sub Refresh(ws As Worksheet, ByVal startRow As Long, ByVal lastDataRow As Long) Dim z1Cache As Object: Set z1Cache = GetCache(CACHE_Z1) @@ -772,239 +998,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 diff --git a/src/sh/tuk/validation/ValidationRule.cls b/src/sh/tuk/validation/ValidationRule.cls index 76f08c3..e1cbb8f 100644 --- a/src/sh/tuk/validation/ValidationRule.cls +++ b/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 diff --git a/通勤手当テンプレート20260528.xlsm b/通勤手当テンプレート20260528.xlsm index 8676b8b..9b6e2b4 100644 Binary files a/通勤手当テンプレート20260528.xlsm and b/通勤手当テンプレート20260528.xlsm differ