From 47c7d95266d861f7794a4b478f8fed389024ab57 Mon Sep 17 00:00:00 2001 From: guanxiangwei Date: Sat, 30 May 2026 18:39:37 +0900 Subject: [PATCH] =?UTF-8?q?=E9=80=9A=E5=8B=A4=E8=AA=8D=E5=AE=9A=E3=82=A8?= =?UTF-8?q?=E3=82=AF=E3=82=BB=E3=83=AB=E3=83=84=E3=83=BC=E3=83=AB=E5=AF=BE?= =?UTF-8?q?=E5=BF=9C16?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- src/sh/tuk/module/Common_Functions.bas | 151 ----------- src/sh/tuk/module/ValidationRuleEnums.bas | 13 +- src/sh/tuk/sheet/C1.cls | 291 +++++++++------------ src/sh/tuk/sheet/M1.cls | 76 +++--- src/sh/tuk/sheet/M2.cls | 213 +++++++-------- src/sh/tuk/validation/ValidationResult.cls | 2 +- src/sh/tuk/validation/ValidationRule.cls | 11 - 7 files changed, 283 insertions(+), 474 deletions(-) diff --git a/src/sh/tuk/module/Common_Functions.bas b/src/sh/tuk/module/Common_Functions.bas index 2a902cf..8e91896 100644 --- a/src/sh/tuk/module/Common_Functions.bas +++ b/src/sh/tuk/module/Common_Functions.bas @@ -433,154 +433,3 @@ End Function Function ColNum(colLetter As String) As Long ColNum = Range(colLetter & "1").Column End Function - -'Check required field is not empty -Function CheckRequired(ByVal ws As Worksheet, ByVal rowNum As Long, ByVal colNum As Long, ByVal errorCol As String) As Boolean - Dim checkValue As String: checkValue = Trim(ws.Cells(rowNum, colNum).Value) - If checkValue = "" Then - Dim letter As String: letter = ColLetter(colNum) - ws.Cells(rowNum, errorCol).Value = GetErrorMsg("E002", letter & rowNum) - ws.Cells(rowNum, colNum).Interior.Color = RGB(255, 0, 0) - CheckRequired = False - Exit Function - End If - CheckRequired = True -End Function - -'Check character length -Function CheckChar(ByVal ws As Worksheet, ByVal rowNum As Long, ByVal colNum As Long, ByVal charLength As Long, ByVal errorCol As String) - Dim checkValue As String: checkValue = Trim(ws.Cells(rowNum, colNum).Value) - If Len(checkValue) <> charLength Then - Dim letter As String: letter = ColLetter(colNum) - ws.Cells(rowNum, errorCol).Value = GetErrorMsg("E006", letter & rowNum, charLength) - ws.Cells(rowNum, colNum).Interior.Color = RGB(255, 0, 0) - CheckChar = False - Exit Function - End If - CheckChar = True -End Function - -'Check alphanumeric characters -Function CheckAlphanumeric(ByVal ws As Worksheet, ByVal rowNum As Long, ByVal colNum As Long, ByVal charLength As Long, ByVal errorCol As String) - Dim checkValue As String: checkValue = Trim(ws.Cells(rowNum, colNum).Value) - Dim letter As String: letter = ColLetter(colNum) - Dim i As Long - Dim ch As String - For i = 1 To charLength - ch = Mid(checkValue, i, 1) - If Not ((ch >= "0" And ch <= "9") Or (ch >= "A" And ch <= "Z") Or (ch >= "a" And ch <= "z")) Then - ws.Cells(rowNum, errorCol).Value = GetErrorMsg("E005", letter & rowNum) - ws.Cells(rowNum, colNum).Interior.Color = RGB(255, 0, 0) - CheckAlphanumeric = False - Exit Function - End If - Next i - - CheckAlphanumeric = True -End Function - -'Check varchar length overflow -Function CheckVarcharOver(ByVal ws As Worksheet, ByVal rowNum As Long, ByVal colNum As Long, ByVal varcharLength As Long, ByVal errorCol As String) - Dim checkValue As String: checkValue = Trim(ws.Cells(rowNum, colNum).Value) - If Len(checkValue) > varcharLength Then - Dim letter As String: letter = ColLetter(colNum) - ws.Cells(rowNum, errorCol).Value = GetErrorMsg("E007", letter & rowNum) - ws.Cells(rowNum, colNum).Interior.Color = RGB(255, 0, 0) - CheckVarcharOver = False - Exit Function - End If - CheckVarcharOver = True -End Function - -'Check number length overflow -Function CheckNumberOver(ByVal ws As Worksheet, ByVal rowNum As Long, ByVal colNum As Long, ByVal numberLength As Long, ByVal errorCol As String) - Dim checkValue As String: checkValue = Trim(ws.Cells(rowNum, colNum).Value) - If Len(checkValue) > numberLength Then - Dim letter As String: letter = ColLetter(colNum) - ws.Cells(rowNum, errorCol).Value = GetErrorMsg("E014", letter & rowNum, numberLength) - ws.Cells(rowNum, colNum).Interior.Color = RGB(255, 0, 0) - CheckNumberOver = False - Exit Function - End If - CheckNumberOver = True -End Function - -'Check value is 0 or 1 -Function Check01(ByVal ws As Worksheet, ByVal rowNum As Long, ByVal colNum As Long, ByVal errorCol As String) - Dim checkValue As String: checkValue = Trim(ws.Cells(rowNum, colNum).Value) - Dim letter As String: letter = ColLetter(colNum) - If checkValue <> "" Then - If Len(checkValue) <> 1 Then - ws.Cells(rowNum, errorCol).Value = GetErrorMsg("E001", letter & rowNum) - ws.Cells(rowNum, colNum).Interior.Color = RGB(255, 0, 0) - Check01 = False - Exit Function - End If - If checkValue <> "0" And checkValue <> "1" Then - ws.Cells(rowNum, errorCol).Value = GetErrorMsg("E008", letter & rowNum) - ws.Cells(rowNum, colNum).Interior.Color = RGB(255, 0, 0) - Check01 = False - Exit Function - End If - End If - Check01 = True -End Function - -'Check value is 1 or 2 -Function Check12(ByVal ws As Worksheet, ByVal rowNum As Long, ByVal colNum As Long, ByVal errorCol As String) - Dim checkValue As String: checkValue = Trim(ws.Cells(rowNum, colNum).Value) - Dim letter As String: letter = ColLetter(colNum) - If checkValue <> "" Then - If Len(checkValue) <> 1 Then - ws.Cells(rowNum, errorCol).Value = GetErrorMsg("E001", letter & rowNum) - ws.Cells(rowNum, colNum).Interior.Color = RGB(255, 0, 0) - Check12 = False - Exit Function - End If - If checkValue <> "1" And checkValue <> "2" Then - ws.Cells(rowNum, errorCol).Value = GetErrorMsg("E009", letter & rowNum) - ws.Cells(rowNum, colNum).Interior.Color = RGB(255, 0, 0) - Check12 = False - Exit Function - End If - End If - Check12 = True -End Function - -'Check duplicate value in column -Function CheckDuplicate(ByVal ws As Worksheet, ByVal rowNum As Long, ByVal colNum As Long, ByVal errorCol As String) As Boolean - Dim checkValue As String: checkValue = Trim(ws.Cells(rowNum, colNum).Value) - Dim letter As String: letter = ColLetter(colNum) - Dim i As Long - - For i = 7 To rowNum - 1 - If Trim(ws.Cells(i, colNum).Value) = checkValue Then - ws.Cells(rowNum, errorCol).Value = GetErrorMsg("E010", letter & rowNum, checkValue) - ws.Cells(rowNum, colNum).Interior.Color = RGB(255, 0, 0) - CheckDuplicate = False - Exit Function - End If - Next i - - CheckDuplicate = True -End Function - -'Check numeric value -Function CheckNumber(ByVal ws As Worksheet, ByVal rowNum As Long, ByVal colNum As Long, ByVal errorCol As String) As Boolean - Dim checkValue As String: checkValue = Trim(ws.Cells(rowNum, colNum).Value) - Dim letter As String: letter = ColLetter(colNum) - - If checkValue = "" Then - CheckNumber = True - Exit Function - End If - - If Not IsNumeric(checkValue) Then - ws.Cells(rowNum, errorCol).Value = GetErrorMsg("E011", letter & rowNum) - ws.Cells(rowNum, colNum).Interior.Color = RGB(255, 0, 0) - CheckNumber = False - Exit Function - End If - - CheckNumber = True -End Function diff --git a/src/sh/tuk/module/ValidationRuleEnums.bas b/src/sh/tuk/module/ValidationRuleEnums.bas index fbeafed..d76df8a 100644 --- a/src/sh/tuk/module/ValidationRuleEnums.bas +++ b/src/sh/tuk/module/ValidationRuleEnums.bas @@ -14,4 +14,15 @@ Public Const ValRule_Char As Long = 6 Public Const ValRule_Varchar As Long = 7 Public Const ValRule_Check01 As Long = 8 Public Const ValRule_Alphanumeric As Long = 9 -Public Const ValRule_Custom As Long = 11 \ No newline at end of file +Public Const ValRule_Custom As Long = 11 + +' --- Error Codes --- +Public Const ERR_REQUIRED As String = "E002" +Public Const ERR_INVALID As String = "E001" +Public Const ERR_RANGE As String = "E004" +Public Const ERR_NOT_EXIST As String = "E004" +Public Const ERR_DUPLICATE As String = "E010" +Public Const ERR_CHARLEN As String = "E006" +Public Const ERR_VARLEN As String = "E007" +Public Const ERR_CHECK01 As String = "E008" +Public Const ERR_NUMDIGITS As String = "E014" \ No newline at end of file diff --git a/src/sh/tuk/sheet/C1.cls b/src/sh/tuk/sheet/C1.cls index 65cc7d6..fc86aa6 100644 --- a/src/sh/tuk/sheet/C1.cls +++ b/src/sh/tuk/sheet/C1.cls @@ -775,198 +775,162 @@ 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 startCol As String: startCol = sheetConf("StartCol") - Dim endCol As String: endCol = sheetConf("EndCol") Dim errorCol As String: errorCol = sheetConf("ErrorCol") + Dim errorCell As Range: Set errorCell = ws.Cells(rowNum, errorCol) - Dim clearRange As Range: Set clearRange = ws.Range(ws.Cells(rowNum, startCol), ws.Cells(rowNum, endCol)) - clearRange.Interior.Color = vbWhite - - ' Required columns: C-G, K-N, AW - Dim requiredCols As Variant - requiredCols = Array("C", "D", "E", "F", "G", "L", "M", "N", "BA") - Dim col As Variant - For Each col In requiredCols - If Trim(Me.Range(col & rowNum).Value & "") = "" Then - Me.Cells(rowNum, errorCol).Value = GetErrorMsg("E002", col & rowNum) - Me.Range(col & rowNum).Interior.Color = RGB(255, 0, 0) - Exit Sub - End If - Next col - - ' validate date - Dim colIndex As Variant - For Each colIndex In DATE_COLS() - Dim cellDate As String: cellDate = Trim(Me.Cells(rowNum, colIndex).Value) - If cellDate <> "" Then - ' Require full YYYY-MM-DD format (output of FormatDateInput) - If Len(cellDate) <> 10 Or Mid(cellDate, 5, 1) <> "-" Or Mid(cellDate, 8, 1) <> "-" Then - Dim letter As String: letter = Split(Me.Cells(1, colIndex).Address, "$")(1) - Me.Cells(rowNum, errorCol).Value = GetErrorMsg("E001", letter & rowNum) - Me.Range(letter & rowNum).Interior.Color = RGB(255, 0, 0) - Exit Sub - End If - End If - Next colIndex - - ' validate number - For Each col In NUMBER_COLS() - Dim cellNumber As String: cellNumber = Trim(Me.Cells(rowNum, col).Value) - If cellNumber <> "" And Not IsNumeric(cellNumber) Then - Me.Cells(rowNum, errorCol).Value = GetErrorMsg("E001", col & rowNum) - Me.Range(col & rowNum).Interior.Color = RGB(255, 0, 0) - Exit Sub - End If - Next col - - ' validate CodeSelect - ' G column [todoke Cde] - Dim ColG As String: ColG = "G" - Dim o3Cache As Object: Set o3Cache = GetCache(CACHE_O3) - Dim todokeCde As String: todokeCde = GetCode(Trim(Me.Cells(rowNum, ColG).Value)) - If Not o3Cache.Exists(todokeCde) Then - Me.Cells(rowNum, errorCol).Value = GetErrorMsg("E001", ColG & rowNum) - Me.Range(ColG & rowNum).Interior.Color = RGB(255, 0, 0) - Exit Sub - End If - - ' I column [address1 J column address2] + ' 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(Me.Cells(rowNum, ColI).Value) - Dim address2 As String: address2 = Trim(Me.Cells(rowNum, ColJ).Value) + 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 - Me.Cells(rowNum, errorCol).Value = ColJ & " column is invalid" - Me.Range(ColJ & rowNum).Interior.Color = RGB(255, 0, 0) - Exit Sub - End If + 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(Me.Cells(rowNum, 3).Value) - If Not o1Cache.Exists(empNo) Then - Me.Cells(rowNum, errorCol).Value = ColI & " column is invalid" - Me.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 - Me.Cells(rowNum, errorCol).Value = ColI & " column is invalid" - Me.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 - Me.Cells(rowNum, errorCol).Value = ColJ & " column is invalid" - Me.Range(ColJ & rowNum).Interior.Color = RGB(255, 0, 0) - Exit Sub - End If + 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 + ' K column (readonly) Dim ColK As String: ColK = "K" - If Trim(Me.Cells(rowNum, ColK).Value) <> "" Then - Me.Cells(rowNum, errorCol).Value = ColK & " column can not be input" - Me.Range(ColK & rowNum).Interior.Color = RGB(255, 0, 0) - Exit Sub + 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 - ' validate CodeSelect - ' M column [oufuku] - Dim ColM As String: ColM = "M" - Dim oufukuList As Object: Set oufukuList = GetCache("oufukuList") - Dim oufukuCde As String: oufukuCde = GetCode(Trim(Me.Cells(rowNum, ColM).Value)) - If Not oufukuList.Exists(oufukuCde) Then - Me.Cells(rowNum, errorCol).Value = GetErrorMsg("E001", ColM & rowNum) - Me.Range(ColM & rowNum).Interior.Color = RGB(255, 0, 0) - Exit Sub - End If - - ' validate CodeSelect - ' N column [koutai] - Dim ColN As String: ColN = "N" - Dim koutaiList As Object: Set koutaiList = GetCache("koutaiList") - Dim koutaiCde As String: koutaiCde = GetCode(Trim(Me.Cells(rowNum, ColN).Value)) - If Not koutaiList.Exists(koutaiCde) Then - Me.Cells(rowNum, errorCol).Value = ColN & " column is invalid" - Me.Range(ColN & rowNum).Interior.Color = RGB(255, 0, 0) - Exit Sub - End If - - ' validate KUKAN_CODE_COLS (S, Z, AG, AN) and related columns + ' 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(Me.Cells(rowNum, kukanCol).Value) - Dim kukanLetter As String: kukanLetter = Split(Me.Cells(1, kukanCol).Address, "$")(1) - + 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 - ' KUKAN_CODE has value, check if exists in m1Cache If Not m1Cache.Exists(kukanCode) Then - Me.Cells(rowNum, errorCol).Value = kukanLetter & " column does not exist" - Me.Range(kukanLetter & rowNum).Interior.Color = RGB(255, 0, 0) + errorCell.Value = kukanLetter & " column does not exist" + ws.Range(kukanLetter & rowNum).Interior.Color = RGB(255, 0, 0) Exit Sub End If - - ' Validate KUKAN_TICKET_COLS and KUKAN_CODE2_COLS + 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(Me.Cells(rowNum, ticketCol).Value)) - Dim code2Val As String: code2Val = GetCode(Trim(Me.Cells(rowNum, code2Col).Value)) - Dim ticketLetter As String: ticketLetter = Split(Me.Cells(1, ticketCol).Address, "$")(1) - Dim code2Letter As String: code2Letter = Split(Me.Cells(1, code2Col).Address, "$")(1) + 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 - Me.Cells(rowNum, errorCol).Value = ticketLetter & " column must be input" - Me.Range(ticketLetter & rowNum).Interior.Color = RGB(255, 0, 0) - Exit Sub + 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 - Me.Cells(rowNum, errorCol).Value = code2Letter & " column is invalid" - Me.Range(code2Letter & rowNum).Interior.Color = RGB(255, 0, 0) + errorCell.Value = code2Letter & " column is invalid" + ws.Range(code2Letter & rowNum).Interior.Color = RGB(255, 0, 0) Exit Sub End If Else - ' Check if ticket exists in m2Cache for this kukanCode Dim kanshuDict As Object If m2Cache.Exists(kukanCode) Then Set kanshuDict = m2Cache(kukanCode) If Not kanshuDict.Exists(ticketVal) Then - Me.Cells(rowNum, errorCol).Value = ticketLetter & " column is invalid" - Me.Range(ticketLetter & rowNum).Interior.Color = RGB(255, 0, 0) + errorCell.Value = ticketLetter & " column is invalid" + ws.Range(ticketLetter & rowNum).Interior.Color = RGB(255, 0, 0) Exit Sub End If - - ' If code2 also has value, verify it exists in m2Cache + If code2Val = "" Then - Me.Cells(rowNum, errorCol).Value = code2Letter & " column should be input" - Me.Range(code2Letter & rowNum).Interior.Color = RGB(255, 0, 0) + 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 - Me.Cells(rowNum, errorCol).Value = code2Letter & " column is invalid" - Me.Range(code2Letter & rowNum).Interior.Color = RGB(255, 0, 0) + 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(Me.Cells(rowNum, teikiCol).Value) + Dim teikiValue As String: teikiValue = Trim(ws.Cells(rowNum, teikiCol).Value) If ticketVal = "1" And teikiValue = "" Then Dim teikiLetter As String: teikiLetter = ColLetter(teikiCol) - Me.Cells(rowNum, errorCol).Value = teikiLetter & " column is required" - Me.Range(teikiLetter & rowNum).Interior.Color = RGB(255, 0, 0) + errorCell.Value = teikiLetter & " column is required" + ws.Range(teikiLetter & rowNum).Interior.Color = RGB(255, 0, 0) Exit Sub End If End If @@ -974,31 +938,30 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As End If End If Else - ' KUKAN_CODE is empty, check that related columns are also empty Dim colGroup As Variant For Each colGroup In kukanCols Dim checkCol As Long: checkCol = colGroup(kukanIdx) - Dim checkVal As String: checkVal = Trim(Me.Cells(rowNum, checkCol).Value) + Dim checkVal As String: checkVal = Trim(ws.Cells(rowNum, checkCol).Value) If checkVal <> "" Then - Dim checkLetter As String: checkLetter = Split(Me.Cells(1, checkCol).Address, "$")(1) - Me.Cells(rowNum, errorCol).Value = checkLetter & " column requires " & kukanLetter & " column" - Me.Range(checkLetter & rowNum).Interior.Color = RGB(255, 0, 0) + 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 - ' Validate KUKAN_CODE_COLS for duplicates (non-empty only) + ' 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(Me.Cells(rowNum, kukanCol).Value) + kukanCode = Trim(ws.Cells(rowNum, kukanCol).Value) If kukanCode <> "" Then If kukanCodes.Exists(kukanCode) Then - kukanLetter = Split(Me.Cells(1, kukanCol).Address, "$")(1) - Me.Cells(rowNum, errorCol).Value = GetErrorMsg("E003", kukanLetter & rowNum) - Me.Range(kukanLetter & rowNum).Interior.Color = RGB(255, 0, 0) + 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 @@ -1006,40 +969,36 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As End If Next kukanIdx - ' Validate H, BB, BC columns - Dim linkCellValue As String: linkCellValue = Me.Cells(3, "H").Value + ' 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(Me.Cells(rowNum, ColBF).Value) - Dim valBG As String: valBG = Trim(Me.Cells(rowNum, ColBG).Value) - + 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 code = "1", BB and BC must be empty If valBF <> "" Then - Me.Cells(rowNum, errorCol).Value = GetErrorMsg("E005", ColBF & rowNum) - Me.Range(ColBF & rowNum).Interior.Color = RGB(255, 0, 0) + errorCell.Value = GetErrorMsg("E005", ColBF & rowNum) + ws.Range(ColBF & rowNum).Interior.Color = RGB(255, 0, 0) Exit Sub End If If valBG <> "" Then - Me.Cells(rowNum, errorCol).Value = GetErrorMsg("E005", ColBG & rowNum) - Me.Range(ColBG & rowNum).Interior.Color = RGB(255, 0, 0) + 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 code = "2", BB and BC must have value If valBF = "" Then - Me.Cells(rowNum, errorCol).Value = GetErrorMsg("E002", ColBF & rowNum) - Me.Range(ColBF & rowNum).Interior.Color = RGB(255, 0, 0) + errorCell.Value = GetErrorMsg("E002", ColBF & rowNum) + ws.Range(ColBF & rowNum).Interior.Color = RGB(255, 0, 0) Exit Sub End If If valBG = "" Then - Me.Cells(rowNum, errorCol).Value = GetErrorMsg("E002", ColBG & rowNum) - Me.Range(ColBG & rowNum).Interior.Color = RGB(255, 0, 0) + errorCell.Value = GetErrorMsg("E002", ColBG & rowNum) + ws.Range(ColBG & rowNum).Interior.Color = RGB(255, 0, 0) Exit Sub End If End If - Me.Cells(rowNum, errorCol).ClearContents Exit Sub ErrHandler: diff --git a/src/sh/tuk/sheet/M1.cls b/src/sh/tuk/sheet/M1.cls index 65b9210..07482a5 100644 --- a/src/sh/tuk/sheet/M1.cls +++ b/src/sh/tuk/sheet/M1.cls @@ -150,50 +150,48 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As Dim result As ValidationResult: Set result = engine.ValidateRow(ws, rowNum, lastDataRow) + If result.ErrorCode <> "" Then Exit Sub ' === Special cases (cross-column / cross-cache) === - If result.ErrorCode = "" Then - 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) + 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) - ' E: must equal CACHE_Z1(D) value - Dim z1Cache As Object: Set z1Cache = GetCache(CACHE_Z1) - Dim dValue As String: dValue = Trim(ws.Range("D" & rowNum).Value) - Dim valArray As Variant: valArray = z1Cache(dValue) - Dim expectedE As String: expectedE = Trim(CStr(valArray(0))) - Dim eValue As String: eValue = Trim(ws.Range("E" & rowNum).Value) - If eValue <> expectedE Then - errorCell.Value = GetErrorMsg(ERR_NOT_EXIST, "E" & CStr(rowNum)) - ws.Range("E" & rowNum).Interior.Color = RGB(255, 0, 0) - Exit Sub - End If - - ' F, G: must be valid stations in the rosen (E), F cannot equal G - Dim z4Rosen As Object: Set z4Rosen = GetCache(CACHE_Z4ROSEN) - Dim stations As Object: Set stations = z4Rosen(eValue) - Dim fValue As String: fValue = Trim(ws.Range("F" & rowNum).Value) - Dim gValue As String: gValue = Trim(ws.Range("G" & rowNum).Value) - If Not stations.Exists(fValue) Then - errorCell.Value = GetErrorMsg(ERR_NOT_EXIST, "F" & CStr(rowNum)) - ws.Range("F" & rowNum).Interior.Color = RGB(255, 0, 0) - Exit Sub - End If - If Not stations.Exists(gValue) Then - errorCell.Value = GetErrorMsg(ERR_NOT_EXIST, "G" & CStr(rowNum)) - ws.Range("G" & rowNum).Interior.Color = RGB(255, 0, 0) - Exit Sub - End If - If fValue = gValue Then - errorCell.Value = GetErrorMsg(ERR_INVALID, "G" & CStr(rowNum)) - ws.Range("F" & rowNum).Interior.Color = RGB(255, 0, 0) - ws.Range("G" & rowNum).Interior.Color = RGB(255, 0, 0) - Exit Sub - End If + ' E: must equal CACHE_Z1(D) value + Dim z1Cache As Object: Set z1Cache = GetCache(CACHE_Z1) + Dim dValue As String: dValue = Trim(ws.Range("D" & rowNum).Value) + Dim valArray As Variant: valArray = z1Cache(dValue) + Dim expectedE As String: expectedE = Trim(CStr(valArray(0))) + Dim eValue As String: eValue = Trim(ws.Range("E" & rowNum).Value) + If eValue <> expectedE Then + errorCell.Value = GetErrorMsg(ERR_NOT_EXIST, "E" & CStr(rowNum)) + ws.Range("E" & rowNum).Interior.Color = RGB(255, 0, 0) + Exit Sub End If + ' F, G: must be valid stations in the rosen (E), F cannot equal G + Dim z4Rosen As Object: Set z4Rosen = GetCache(CACHE_Z4ROSEN) + Dim stations As Object: Set stations = z4Rosen(eValue) + Dim fValue As String: fValue = Trim(ws.Range("F" & rowNum).Value) + Dim gValue As String: gValue = Trim(ws.Range("G" & rowNum).Value) + If Not stations.Exists(fValue) Then + errorCell.Value = GetErrorMsg(ERR_NOT_EXIST, "F" & CStr(rowNum)) + ws.Range("F" & rowNum).Interior.Color = RGB(255, 0, 0) + Exit Sub + End If + If Not stations.Exists(gValue) Then + errorCell.Value = GetErrorMsg(ERR_NOT_EXIST, "G" & CStr(rowNum)) + ws.Range("G" & rowNum).Interior.Color = RGB(255, 0, 0) + Exit Sub + End If + If fValue = gValue Then + errorCell.Value = GetErrorMsg(ERR_INVALID, "G" & CStr(rowNum)) + ws.Range("F" & rowNum).Interior.Color = RGB(255, 0, 0) + ws.Range("G" & rowNum).Interior.Color = RGB(255, 0, 0) + Exit Sub + End If + Exit Sub - ErrHandler: SetLastErrorMsg Err.Description End Sub diff --git a/src/sh/tuk/sheet/M2.cls b/src/sh/tuk/sheet/M2.cls index 2081e87..89035a2 100644 --- a/src/sh/tuk/sheet/M2.cls +++ b/src/sh/tuk/sheet/M2.cls @@ -112,7 +112,6 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As Dim engine As ValidationRuleEngine: Set engine = New ValidationRuleEngine With engine .AddRequired "C" - .AddDuplicate "C" .AddCodeSelect "C", CACHE_M1 .AddRequired "I" .AddRequired "J" @@ -131,117 +130,121 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As Dim result As ValidationResult: Set result = engine.ValidateRow(ws, rowNum, lastDataRow) ' === Special cases (cross-cache / cross-column) === - If result.ErrorCode = "" Then - 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) + If result.ErrorCode <> "" Then Exit Sub - ' J: must exist in T1/T2/T3 cache (determined by I column) - Dim kenshuKbn As String: kenshuKbn = Trim(ws.Range("I" & rowNum).Value) - Dim cache As Object - Select Case kenshuKbn - Case "1": Set cache = GetCache(CACHE_T1) - Case "2": Set cache = GetCache(CACHE_T2) - Case "3": Set cache = GetCache(CACHE_T3) - Case Else - errorCell.Value = GetErrorMsg(ERR_NOT_EXIST, "I" & rowNum) - ws.Range("I" & rowNum).Interior.Color = RGB(255, 0, 0) - Exit Sub - End Select + 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) - Dim code As String: code = Trim(ws.Range("J" & rowNum).Value) - If Not cache.Exists(code) Then - errorCell.Value = GetErrorMsg(ERR_NOT_EXIST, "J" & rowNum) - ws.Range("J" & rowNum).Interior.Color = RGB(255, 0, 0) + ' J: must exist in T1/T2/T3 cache (determined by I column) + Dim kenshuKbn As String: kenshuKbn = Trim(ws.Range("I" & rowNum).Value) + Dim cache As Object + Select Case kenshuKbn + Case "1": Set cache = GetCache(CACHE_T1) + Case "2": Set cache = GetCache(CACHE_T2) + Case "3": Set cache = GetCache(CACHE_T3) + Case Else + errorCell.Value = GetErrorMsg(ERR_NOT_EXIST, "I" & rowNum) + ws.Range("I" & rowNum).Interior.Color = RGB(255, 0, 0) Exit Sub - End If + End Select - ' kenshuKbn-specific: equaledCols, requiredCols, emptyCols - Dim equaledCols As Variant - Dim requiredCols As Variant - Dim emptyCols As Variant - If kenshuKbn = "1" Then - equaledCols = Array("K") - requiredCols = Array("N") - emptyCols = Array("O", "P", "Q", "R") - ElseIf kenshuKbn = "2" Then - equaledCols = Array("K", "L", "M", "N", "O", "P", "Q") - requiredCols = Array("N", "O", "P", "Q") - emptyCols = Array("R") - ElseIf kenshuKbn = "3" Then - equaledCols = Array("K", "L", "M") - requiredCols = Array() - emptyCols = Array("N", "O", "P", "Q", "R") - End If - - ' equaledCols must match cache values - Dim equaledIndex As Long - For equaledIndex = LBound(equaledCols) To UBound(equaledCols) - Dim equaledCol As String: equaledCol = equaledCols(equaledIndex) - Dim equalValue As String: equalValue = Trim(ws.Range(equaledCol & rowNum).Value) - If cache(code)(equaledIndex) <> equalValue Then - errorCell.Value = GetErrorMsg(ERR_INVALID, equaledCol & rowNum) - ws.Range(equaledCol & rowNum).Interior.Color = RGB(255, 0, 0) - Exit Sub - End If - Next equaledIndex - - ' requiredCols must not be empty - Dim requiredCol As Variant - For Each requiredCol In requiredCols - Dim requiredValue As String: requiredValue = Trim(ws.Range(requiredCol & rowNum).Value) - If requiredValue = "" Then - errorCell.Value = GetErrorMsg(ERR_REQUIRED, requiredCol & rowNum) - ws.Range(requiredCol & rowNum).Interior.Color = RGB(255, 0, 0) - Exit Sub - End If - Next requiredCol - - ' emptyCols must be empty - Dim emptyCol As Variant - For Each emptyCol In emptyCols - Dim emptyValue As String: emptyValue = Trim(ws.Range(emptyCol & rowNum).Value) - If emptyValue <> "" Then - errorCell.Value = GetErrorMsg("E005", emptyCol & rowNum) - ws.Range(emptyCol & rowNum).Interior.Color = RGB(255, 0, 0) - Exit Sub - End If - Next emptyCol - - ' Duplicate: C + I + J (+ N if kenshuKbn=1) - Dim sikyuKikan As String: sikyuKikan = Trim(ws.Range("N" & rowNum).Value) - Dim hasError As Boolean: hasError = False - Dim otherValueC As String, otherValueI As String, otherValueJ As String, otherValueN As String - Dim otherRow As Long - For otherRow = 7 To rowNum - 1 - otherValueC = Trim(ws.Cells(otherRow, "C").Value) - otherValueI = Trim(ws.Cells(otherRow, "I").Value) - otherValueJ = Trim(ws.Cells(otherRow, "J").Value) - otherValueN = Trim(ws.Cells(otherRow, "N").Value) - If kenshuKbn = "1" Then - If otherValueC = cValue And otherValueI = kenshuKbn And otherValueJ = code And otherValueN = sikyuKikan Then - hasError = True - End If - Else - If otherValueC = cValue And otherValueI = kenshuKbn And otherValueJ = code Then - hasError = True - End If - End If - - If hasError = True Then - errorCell.Value = GetErrorMsg("E013", otherRow, code) - ws.Cells(rowNum, "C").Interior.Color = RGB(255, 0, 0) - Exit Sub - End If - Next otherRow + Dim kukanCode As String: kukanCode = Trim(ws.Range("C" & rowNum).Value) + Dim code As String: code = Trim(ws.Range("J" & rowNum).Value) + If Not cache.Exists(code) Then + errorCell.Value = GetErrorMsg(ERR_NOT_EXIST, "J" & rowNum) + ws.Range("J" & rowNum).Interior.Color = RGB(255, 0, 0) + Exit Sub End If - ' validate passed, clear error cell and setup backcolor - errorCell.ClearContents - Call ChangeBackColor(rowNum) - Exit Sub + ' kenshuKbn-specific: equaledCols, requiredCols, emptyCols + Dim equaledCols As Variant + Dim requiredCols As Variant + Dim emptyCols As Variant + If kenshuKbn = "1" Then + equaledCols = Array("K") + requiredCols = Array("N") + emptyCols = Array("O", "P", "Q", "R") + ElseIf kenshuKbn = "2" Then + equaledCols = Array("K", "L", "M", "N", "O", "P", "Q") + requiredCols = Array("N", "O", "P", "Q") + emptyCols = Array("R") + ElseIf kenshuKbn = "3" Then + equaledCols = Array("K", "L", "M") + requiredCols = Array() + emptyCols = Array("N", "O", "P", "Q", "R") + End If + ' equaledCols must match cache values + Dim equaledIndex As Long + For equaledIndex = LBound(equaledCols) To UBound(equaledCols) + Dim equaledCol As String: equaledCol = equaledCols(equaledIndex) + Dim equalValue As String: equalValue = Trim(ws.Range(equaledCol & rowNum).Value) + If cache(code)(equaledIndex) <> equalValue Then + errorCell.Value = GetErrorMsg(ERR_INVALID, equaledCol & rowNum) + ws.Range(equaledCol & rowNum).Interior.Color = RGB(255, 0, 0) + Exit Sub + End If + Next equaledIndex + + ' requiredCols must not be empty + Dim requiredCol As Variant + For Each requiredCol In requiredCols + Dim requiredValue As String: requiredValue = Trim(ws.Range(requiredCol & rowNum).Value) + If requiredValue = "" Then + errorCell.Value = GetErrorMsg(ERR_REQUIRED, requiredCol & rowNum) + ws.Range(requiredCol & rowNum).Interior.Color = RGB(255, 0, 0) + Exit Sub + End If + Next requiredCol + + ' emptyCols must be empty + Dim emptyCol As Variant + For Each emptyCol In emptyCols + Dim emptyValue As String: emptyValue = Trim(ws.Range(emptyCol & rowNum).Value) + If emptyValue <> "" Then + errorCell.Value = GetErrorMsg("E005", emptyCol & rowNum) + ws.Range(emptyCol & rowNum).Interior.Color = RGB(255, 0, 0) + Exit Sub + End If + Next emptyCol + + ' Duplicate: C + I + J (+ N if kenshuKbn=1) + Dim sikyuKikan As String: sikyuKikan = Trim(ws.Range("N" & rowNum).Value) + Dim hasError As Boolean: hasError = False + Dim otherValueC As String, otherValueI As String, otherValueJ As String, otherValueN As String + Dim otherRow As Long + If rowNum < 9 Then + Call ChangeBackColor(rowNum) + Exit Sub + End If + + For otherRow = 8 To rowNum - 1 + otherValueC = Trim(ws.Cells(otherRow, "C").Value) + otherValueI = Trim(ws.Cells(otherRow, "I").Value) + otherValueJ = Trim(ws.Cells(otherRow, "J").Value) + otherValueN = Trim(ws.Cells(otherRow, "N").Value) + If kenshuKbn = "1" Then + If otherValueC = kukanCode And otherValueI = kenshuKbn And otherValueJ = code And otherValueN = sikyuKikan Then + hasError = True + End If + Else + If otherValueC = kukanCode And otherValueI = kenshuKbn And otherValueJ = code Then + hasError = True + End If + End If + + If hasError = True Then + errorCell.Value = GetErrorMsg("E013", otherRow, code) + ws.Cells(rowNum, "C").Interior.Color = RGB(255, 0, 0) + Exit Sub + End If + Next otherRow + + Call ChangeBackColor(rowNum) + + Exit Sub ErrHandler: SetLastErrorMsg Err.Description End Sub diff --git a/src/sh/tuk/validation/ValidationResult.cls b/src/sh/tuk/validation/ValidationResult.cls index e82c939..0eea623 100644 --- a/src/sh/tuk/validation/ValidationResult.cls +++ b/src/sh/tuk/validation/ValidationResult.cls @@ -22,7 +22,7 @@ End Sub ' ============================================================ ' Mark this result as a failure. ' ============================================================ -Public Sub SetFail(errorCode As String, errorCol As Long, errorRow As Long, Optional extra As String = "") +Public Sub SetFail(ByVal errorCode As String, errorCol As Long, errorRow As Long, Optional extra As String = "") Passed = False Me.ErrorCode = errorCode Me.ErrorCol = errorCol diff --git a/src/sh/tuk/validation/ValidationRule.cls b/src/sh/tuk/validation/ValidationRule.cls index cb53af2..76f08c3 100644 --- a/src/sh/tuk/validation/ValidationRule.cls +++ b/src/sh/tuk/validation/ValidationRule.cls @@ -24,17 +24,6 @@ Public NumberDigits As Long Public NumberDec As Long Public StartRow As Long -' --- Error Codes --- -Private Const ERR_REQUIRED As String = "E002" -Private Const ERR_INVALID As String = "E001" -Private Const ERR_RANGE As String = "E004" -Private Const ERR_NOT_EXIST As String = "E004" -Private Const ERR_DUPLICATE As String = "E010" -Private Const ERR_CHARLEN As String = "E006" -Private Const ERR_VARLEN As String = "E007" -Private Const ERR_CHECK01 As String = "E008" -Private Const ERR_NUMDIGITS As String = "E014" - ' ============================================================ ' Execute this rule against a worksheet row. ' Returns a ValidationResult object.