updsv7/vba
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

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

Browse Source
This commit is contained in:
guanxiangwei
2026-05-30 18:39:37 +09:00
parent 8611cb4f1e
commit 47c7d95266
7 changed files with 283 additions and 474 deletions
Download Patch File Download Diff File Expand all files Collapse all files

151
src/sh/tuk/module/Common_Functions.bas
View File

@@ -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

11
src/sh/tuk/module/ValidationRuleEnums.bas
View File

@@ -15,3 +15,14 @@ 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
' --- 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"

249
src/sh/tuk/sheet/C1.cls
View File

@@ -776,129 +776,97 @@ End Sub
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)
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)
Dim empNo As String: empNo = Trim(ws.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)
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
Me.Cells(rowNum, errorCol).Value = ColI & " column is invalid"
Me.Range(ColI & rowNum).Interior.Color = RGB(255, 0, 0)
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
Me.Cells(rowNum, errorCol).Value = ColJ & " column is invalid"
Me.Range(ColJ & rowNum).Interior.Color = RGB(255, 0, 0)
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)
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
@@ -907,66 +875,62 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
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)
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:

4
src/sh/tuk/sheet/M1.cls
View File

@@ -150,8 +150,8 @@ 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")
@@ -190,10 +190,8 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
ws.Range("G" & rowNum).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
End If
Exit Sub
ErrHandler:
SetLastErrorMsg Err.Description
End Sub

21
src/sh/tuk/sheet/M2.cls
View File

@@ -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,7 +130,8 @@ 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
If result.ErrorCode <> "" Then Exit Sub
Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName)
Dim errorCol As String: errorCol = sheetConf("ErrorCol")
@@ -150,6 +150,7 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
Exit Sub
End Select
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)
@@ -214,17 +215,22 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
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
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 = cValue And otherValueI = kenshuKbn And otherValueJ = code And otherValueN = sikyuKikan Then
If otherValueC = kukanCode 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
If otherValueC = kukanCode And otherValueI = kenshuKbn And otherValueJ = code Then
hasError = True
End If
End If
@@ -235,13 +241,10 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
Exit Sub
End If
Next otherRow
End If
' validate passed, clear error cell and setup backcolor
errorCell.ClearContents
Call ChangeBackColor(rowNum)
Exit Sub
Exit Sub
ErrHandler:
SetLastErrorMsg Err.Description
End Sub

2
src/sh/tuk/validation/ValidationResult.cls
View File

@@ -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

11
src/sh/tuk/validation/ValidationRule.cls
View File

@@ -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.