通勤認定エクセルツール対応14
This commit is contained in:
guanxiangwei
@@ -58,6 +58,8 @@ Before editing any sheet class or cache logic, **read the design document first*
|
||||
|
||||
**Rule**: Do not guess sheet layout or cache structure. Look it up in the design document.
|
||||
|
||||
**When cache structure is modified**: Update the design document accordingly — including CACHE_* constant table, cache architecture section, and any affected data flow diagrams.
|
||||
|
||||
vba/
|
||||
AGENTS.md, README.md, .gitignore, LICENSE
|
||||
通勤手当テンプレート2026xxxx.xlsm (latest date version)
|
||||
|
||||
@@ -7,14 +7,13 @@ Sub ImportModulesAndSheets_Safe()
|
||||
|
||||
Dim basePath As String: basePath = ThisWorkbook.Path
|
||||
If Right(basePath, 1) <> "\" Then basePath = basePath & "\"
|
||||
Const PROJECT_PATH As String = basePath
|
||||
Const MODULE_PATH As String = basePath & "src\sh\tuk\module"
|
||||
Const SHEET_PATH As String = basePath & "src\sh\tuk\sheet"
|
||||
Dim modulePath As String: modulePath = basePath & "src\sh\tuk\module"
|
||||
Dim sheetPath As String: sheetPath = basePath & "src\sh\tuk\sheet"
|
||||
|
||||
' --- Phase 1: Validation ---
|
||||
Debug.Print "[LOG] Starting validation phase..."
|
||||
Dim validationErrors As String
|
||||
validationErrors = ValidateAllFilesAndTargets(MODULE_PATH, SHEET_PATH)
|
||||
validationErrors = ValidateAllFilesAndTargets(modulePath, sheetPath)
|
||||
|
||||
If validationErrors <> "" Then
|
||||
MsgBox "Validation failed. Import aborted:" & vbCrLf & vbCrLf & validationErrors, vbCritical
|
||||
@@ -27,8 +26,9 @@ Sub ImportModulesAndSheets_Safe()
|
||||
Application.ScreenUpdating = False
|
||||
|
||||
Debug.Print "[LOG] Validation passed. Starting import phase..."
|
||||
ImportStandardModules MODULE_PATH
|
||||
ImportSheetCLSFiles SHEET_PATH
|
||||
ImportStandardModules modulePath
|
||||
ImportSheetCLSFiles sheetPath
|
||||
ImportValidationClasses sheetPath
|
||||
|
||||
Application.ScreenUpdating = True
|
||||
MsgBox "All .bas and .cls files imported successfully!", vbInformation
|
||||
@@ -199,3 +199,44 @@ Private Function ExtractPureCodeFromCls(filePath As String) As String
|
||||
ts.Close
|
||||
ExtractPureCodeFromCls = result
|
||||
End Function
|
||||
|
||||
' Import ValidationRuleEngine.cls, ValidationRule.cls, ValidationResult.cls
|
||||
' as class modules (not sheet classes)
|
||||
Private Sub ImportValidationClasses(sheetPath As String)
|
||||
Dim fso As Object
|
||||
Set fso = CreateObject("Scripting.FileSystemObject")
|
||||
|
||||
Dim valPath As String: valPath = sheetPath & "\..\validation"
|
||||
Debug.Print "[LOG] Starting import of validation classes from: " & valPath
|
||||
|
||||
Dim classFiles As Variant
|
||||
classFiles = Array("ValidationResult.cls", "ValidationRule.cls", "ValidationRuleEngine.cls")
|
||||
|
||||
Dim i As Long
|
||||
For i = 0 To UBound(classFiles)
|
||||
Dim filePath As String: filePath = valPath & "\" & classFiles(i)
|
||||
|
||||
If Not fso.FileExists(filePath) Then
|
||||
Debug.Print "[WARNING] Validation class not found: " & filePath
|
||||
Else
|
||||
Dim clsName As String: clsName = fso.GetBaseName(classFiles(i))
|
||||
|
||||
' Remove existing class component if any
|
||||
On Error Resume Next
|
||||
ThisWorkbook.VBProject.VBComponents.Remove ThisWorkbook.VBProject.VBComponents(clsName)
|
||||
On Error GoTo 0
|
||||
|
||||
DoEvents
|
||||
Application.Wait Now + TimeSerial(0, 0, 1)
|
||||
|
||||
' Import as class module
|
||||
ThisWorkbook.VBProject.VBComponents.Import filePath
|
||||
|
||||
DoEvents
|
||||
|
||||
Debug.Print "[LOG] Successfully imported validation class: " & clsName
|
||||
End If
|
||||
Next i
|
||||
|
||||
Debug.Print "[LOG] Finished importing validation classes."
|
||||
End Sub
|
||||
@@ -1,8 +1,23 @@
|
||||
Attribute VB_Name = "Common_Button"
|
||||
Option Explicit
|
||||
|
||||
' --- Public Variables ---
|
||||
Public lastErrorMsg As String
|
||||
' --- Private Variables ---
|
||||
Private m_LastErrorMsg As String
|
||||
|
||||
' ============================================================
|
||||
' Get/Set last error message
|
||||
' ============================================================
|
||||
Public Sub SetLastErrorMsg(msg As String)
|
||||
m_LastErrorMsg = msg
|
||||
End Sub
|
||||
|
||||
Public Function GetLastErrorMsg() As String
|
||||
GetLastErrorMsg = m_LastErrorMsg
|
||||
End Function
|
||||
|
||||
Public Sub ClearLastErrorMsg()
|
||||
m_LastErrorMsg = ""
|
||||
End Sub
|
||||
|
||||
' ============================================================
|
||||
' Module Name: Common_Button
|
||||
@@ -67,6 +82,7 @@ Sub RefreshCache_Button()
|
||||
Exit Sub
|
||||
|
||||
ErrorHandler:
|
||||
Debug.Print "sheetName = " & sheetName
|
||||
HandleError "RefreshCache_Button"
|
||||
End Sub
|
||||
|
||||
@@ -373,10 +389,10 @@ Public Function RunValidationSilent(ws As Worksheet) As Long
|
||||
Dim r As Long
|
||||
Dim hasError As Boolean: hasError = False
|
||||
For r = startRow To lastDataRow
|
||||
lastErrorMsg = ""
|
||||
Application.Run validate, ws, r, lastDataRow
|
||||
If lastErrorMsg <> "" Then
|
||||
Err.Raise ERR_VALIDATION_FAILED, "RunValidationSilent", lastErrorMsg
|
||||
SetLastErrorMsg ""
|
||||
Application.Run validate, ws, r, lastDataRow
|
||||
If GetLastErrorMsg() <> "" Then
|
||||
Err.Raise ERR_VALIDATION_FAILED, "RunValidationSilent", GetLastErrorMsg()
|
||||
End If
|
||||
Dim errorMessage As String: errorMessage = Trim(ws.Cells(r, errorCol).Value)
|
||||
Dim errorCode As String: errorCode = GetCode(errorMessage)
|
||||
|
||||
@@ -52,8 +52,8 @@ Sub WriteCSVFromArray( _
|
||||
If rows = 0 Or cols = 0 Then Exit Sub ' Empty array, exit early
|
||||
|
||||
' === Build CSV content ===
|
||||
Dim outputLines As Collection
|
||||
Set outputLines = New Collection
|
||||
Dim outputLines As VBA.Collection
|
||||
Set outputLines = New VBA.Collection
|
||||
|
||||
Dim i As Long, j As Long
|
||||
Dim rowStr As String
|
||||
@@ -129,8 +129,8 @@ ExitPoint:
|
||||
ArrayDimensions = dimCount - 1
|
||||
End Function
|
||||
|
||||
' Helper function: convert a Collection to a 1D array (for use with Join)
|
||||
Private Function CollectionToArray(col As Collection) As Variant
|
||||
' Helper function: convert a VBA.Collection to a 1D array (for use with Join)
|
||||
Private Function CollectionToArray(col As VBA.Collection) As Variant
|
||||
If col.Count = 0 Then
|
||||
CollectionToArray = Array()
|
||||
Exit Function
|
||||
@@ -210,7 +210,7 @@ Function ReadCSVAs2DArrayStrict( _
|
||||
textContent = Replace(textContent, vbCr, vbLf)
|
||||
|
||||
' === transfer into collection ===
|
||||
Dim lines As Collection
|
||||
Dim lines As VBA.Collection
|
||||
Set lines = ParseCSVLines(textContent)
|
||||
|
||||
' === validate empty ===
|
||||
@@ -259,14 +259,14 @@ Function ReadCSVAs2DArrayStrict( _
|
||||
End Function
|
||||
|
||||
' Helper function: Parse CSV text into collection of string arrays (zero-based per row)
|
||||
Private Function ParseCSVLines(ByVal csvText As String) As Collection
|
||||
Set ParseCSVLines = New Collection
|
||||
Private Function ParseCSVLines(ByVal csvText As String) As VBA.Collection
|
||||
Set ParseCSVLines = New VBA.Collection
|
||||
Dim length As Long: length = Len(csvText)
|
||||
If length = 0 Then Exit Function
|
||||
|
||||
Dim i As Long: i = 1
|
||||
Dim currentField As String
|
||||
Dim currentRow As Collection: Set currentRow = New Collection
|
||||
Dim currentRow As VBA.Collection: Set currentRow = New VBA.Collection
|
||||
Dim inQuotes As Boolean
|
||||
Dim c As String
|
||||
|
||||
@@ -314,7 +314,7 @@ Private Function ParseCSVLines(ByVal csvText As String) As Collection
|
||||
Next k
|
||||
End If
|
||||
ParseCSVLines.Add arr
|
||||
Set currentRow = New Collection
|
||||
Set currentRow = New VBA.Collection
|
||||
currentField = ""
|
||||
inQuotes = False
|
||||
i = i + 1
|
||||
|
||||
@@ -429,6 +429,11 @@ Function ColLetter(colNum As Long) As String
|
||||
ColLetter = Split(Cells(1, colNum).Address, "$")(1)
|
||||
End Function
|
||||
|
||||
'Convert column letter to number
|
||||
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)
|
||||
|
||||
17
src/sh/tuk/module/ValidationRuleEnums.bas
Normal file
17
src/sh/tuk/module/ValidationRuleEnums.bas
Normal file
@@ -0,0 +1,17 @@
|
||||
Attribute VB_Name = "ValidationRuleEnums"
|
||||
' ValidationRuleEnums.bas
|
||||
' Standard module for shared rule-type constants.
|
||||
' Using Long constants instead of Enum to avoid VBA class-module ambiguity issues.
|
||||
Option Explicit
|
||||
|
||||
Public Const ValRule_Required As Long = 0
|
||||
Public Const ValRule_Date As Long = 1
|
||||
Public Const ValRule_Number As Long = 2
|
||||
Public Const ValRule_CodeSelect As Long = 3
|
||||
Public Const ValRule_Range As Long = 4
|
||||
Public Const ValRule_Duplicate As Long = 5
|
||||
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
|
||||
@@ -1043,7 +1043,7 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
|
||||
Exit Sub
|
||||
|
||||
ErrHandler:
|
||||
lastErrorMsg = Err.Description
|
||||
SetLastErrorMsg Err.Description
|
||||
End Sub
|
||||
|
||||
' Create teiki dropdown based on M2 cache
|
||||
|
||||
@@ -86,22 +86,6 @@ Private Sub Worksheet_Change(ByVal Target As Range)
|
||||
Next
|
||||
End If
|
||||
|
||||
' === Column E changes (rosen name): Build F column (station from) dropdown ===
|
||||
' If Target.Column = 4 And Target.Row >= 7 Then
|
||||
' Dim cellE As Range
|
||||
' For Each cellE In Target
|
||||
' Dim rosenVal As String: rosenVal = Trim(cellE.Value)
|
||||
' If rosenVal = "" Then
|
||||
' Me.Cells(cellE.Row, 6).ClearContents
|
||||
' Me.Cells(cellE.Row, 8).ClearContents
|
||||
' Me.Cells(cellE.Row, 6).Validation.Delete
|
||||
' Me.Cells(cellE.Row, 8).Validation.Delete
|
||||
' Else
|
||||
' Call BuildZ4StationFromDropdown(Me, "F", cellE.Row, rosenVal)
|
||||
' End If
|
||||
' Next
|
||||
' End If
|
||||
|
||||
' === Column F changes (station from): Build H column (station to) dropdown ===
|
||||
If Target.Column = 6 And Target.Row >= 7 Then
|
||||
Dim cellF As Range
|
||||
@@ -137,98 +121,81 @@ Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
|
||||
End If
|
||||
End Sub
|
||||
|
||||
Private Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As Long)
|
||||
'
|
||||
Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As Long)
|
||||
On Error GoTo ErrHandler
|
||||
|
||||
Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
|
||||
Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName)
|
||||
Dim engine As ValidationRuleEngine: Set engine = New ValidationRuleEngine
|
||||
With engine
|
||||
.AddRequired "C"
|
||||
.AddChar "C", 5
|
||||
.AddAlphanumeric "C"
|
||||
.AddDuplicate "C"
|
||||
.AddRequired "D"
|
||||
.AddCodeSelect "D", CACHE_Z1
|
||||
.AddRequired "E"
|
||||
.AddCodeSelect "E", CACHE_Z4ROSEN
|
||||
.AddRequired "F"
|
||||
.AddRequired "G"
|
||||
.AddRequired "I"
|
||||
.AddRequired "L"
|
||||
.AddCodeSelect "K", "renrakuList"
|
||||
.AddCodeSelect "L", "tokubetuList"
|
||||
.AddNumber "H", 6, 1
|
||||
.AddNumber "I", 5
|
||||
.AddNumber "J", 6
|
||||
.AddNumber "N"
|
||||
|
||||
Dim startCol As String: startCol = sheetConf("StartCol")
|
||||
Dim endCol As String: endCol = sheetConf("EndCol")
|
||||
Dim errorCol As String: errorCol = sheetConf("ErrorCol")
|
||||
End With
|
||||
|
||||
Dim clearRange As Range: Set clearRange = ws.Range(ws.Cells(rowNum, startCol), ws.Cells(rowNum, endCol))
|
||||
clearRange.Interior.Color = vbWhite
|
||||
Dim result As ValidationResult: Set result = engine.ValidateRow(ws, rowNum, lastDataRow)
|
||||
|
||||
Dim errorCell As Range: Set errorCell = ws.Cells(rowNum, errorCol)
|
||||
' === 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)
|
||||
|
||||
' Check column required
|
||||
Dim colLetter As Variant
|
||||
For Each colLetter In Array("C", "D", "E", "F", "G", "I", "L")
|
||||
If Trim(ws.Range(colLetter & rowNum).Value) = "" Then
|
||||
errorCell.Value = GetErrorMsg("E002", colLetter & rowNum)
|
||||
ws.Range(colLetter & rowNum).Interior.Color = RGB(255, 0, 0)
|
||||
Exit Sub
|
||||
End If
|
||||
Next colLetter
|
||||
|
||||
' Check column numeric
|
||||
For Each colLetter In Array("H", "I", "J", "N")
|
||||
Dim val As String: val = Trim(ws.Range(colLetter & rowNum).Value)
|
||||
If val <> "" And Not IsNumeric(val) Then
|
||||
errorCell.Value = GetErrorMsg("E011", colLetter & rowNum)
|
||||
ws.Range(colLetter & rowNum).Interior.Color = RGB(255, 0, 0)
|
||||
Exit Sub
|
||||
End If
|
||||
Next colLetter
|
||||
|
||||
' Check C column repeat
|
||||
Dim cValue As String: cValue = Trim(ws.Range("C" & rowNum).Value)
|
||||
Dim foundCell As Range
|
||||
Set foundCell = ws.Range("C7:C" & lastDataRow).Find(What:=cValue, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext)
|
||||
If Not foundCell Is Nothing Then
|
||||
If foundCell.Row <> rowNum Then
|
||||
errorCell.Value = "C column value is duplicated"
|
||||
ws.Range("C" & rowNum).Interior.Color = RGB(255, 0, 0)
|
||||
Exit Sub
|
||||
End If
|
||||
End If
|
||||
|
||||
' Check D and E column in the cache
|
||||
Dim z1Cache As Object: Set z1Cache = GetCache(CACHE_Z1)
|
||||
|
||||
Dim dValue As String: dValue = Trim(ws.Range("D" & rowNum).Value)
|
||||
Dim eValue As String: eValue = Trim(ws.Range("E" & rowNum).Value)
|
||||
|
||||
If Not z1Cache.Exists(dValue) Then
|
||||
errorCell.Value = GetErrorMsg("E004", "D" & rowNum)
|
||||
ws.Range("D" & rowNum).Interior.Color = RGB(255, 0, 0)
|
||||
Exit Sub
|
||||
Else
|
||||
Dim valueArray As Variant
|
||||
valueArray = z1Cache(dValue)
|
||||
If Not IsArray(valueArray) Or UBound(valueArray) < 0 Then
|
||||
errorCell.Value = "Invalid reference data for D column."
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
Dim expectedEValue As String
|
||||
expectedEValue = Trim(CStr(valueArray(0)))
|
||||
|
||||
If eValue <> expectedEValue Then
|
||||
errorCell.Value = "E column does not match reference data."
|
||||
' 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
|
||||
End If
|
||||
|
||||
' Check L column in the tokubetuList
|
||||
Dim tokubetuList As Object: Set tokubetuList = GetCache("tokubetuList")
|
||||
Dim lValue As String: lValue = Trim(ws.Range("L" & rowNum).Value)
|
||||
If Not tokubetuList.Exists(lValue) Then
|
||||
errorCell.Value = "L column does not exist."
|
||||
ws.Range("L" & rowNum).Interior.Color = RGB(255, 0, 0)
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
' Validation passed - clear error
|
||||
If Not StartsWith(errorCell.Value, "W") Then
|
||||
errorCell.ClearContents
|
||||
End If
|
||||
Exit Sub
|
||||
|
||||
ErrHandler:
|
||||
lastErrorMsg = Err.Description
|
||||
SetLastErrorMsg Err.Description
|
||||
End Sub
|
||||
|
||||
' obtain z1 master data, and update column E
|
||||
@@ -239,11 +206,20 @@ Private Sub Refresh(ws As Worksheet, ByVal startRow As Long, ByVal lastDataRow A
|
||||
On Error GoTo ErrorHandler
|
||||
|
||||
Dim r As Long
|
||||
Dim z4Rosen As Object: Set z4Rosen = GetCache(CACHE_Z4ROSEN)
|
||||
For r = startRow To lastDataRow
|
||||
Dim dVal As String: dVal = Trim(ws.Cells(r, 4).Value) ' Column D
|
||||
If dVal <> "" And z1Cache.Exists(dVal) Then
|
||||
Dim valsD As Variant: valsD = z1Cache(dVal)
|
||||
ws.Cells(r, 5).Value = valsD(0) ' Column E
|
||||
Dim kikanName As String: kikanName = valsD(0)
|
||||
If z4Rosen.Exists(kikanName) Then
|
||||
Call BuildZ4StationFromDropdown(ws, "F", r, kikanName)
|
||||
Dim stationFrom As String: stationFrom = Trim(ws.Cells(r, 6).Value)
|
||||
If stationFrom <> "" Then
|
||||
Call BuildZ4StationToDropdown(ws, "G", r, kikanName, stationFrom)
|
||||
End If
|
||||
End If
|
||||
End If
|
||||
Call BuildTokubetuDropdown(ws, "L", r)
|
||||
Call BuildRenrakuDropdown(ws, "K", r)
|
||||
|
||||
@@ -109,162 +109,141 @@ End Sub
|
||||
Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As Long)
|
||||
On Error GoTo ErrHandler
|
||||
|
||||
Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
|
||||
Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName)
|
||||
Dim engine As ValidationRuleEngine: Set engine = New ValidationRuleEngine
|
||||
With engine
|
||||
.AddRequired "C"
|
||||
.AddDuplicate "C"
|
||||
.AddCodeSelect "C", CACHE_M1
|
||||
.AddRequired "I"
|
||||
.AddRequired "J"
|
||||
.AddRequired "K"
|
||||
.AddRequired "L"
|
||||
.AddRequired "M"
|
||||
.AddNumber "L"
|
||||
.AddNumber "M"
|
||||
.AddNumber "N"
|
||||
.AddNumber "O"
|
||||
.AddNumber "P"
|
||||
.AddNumber "Q"
|
||||
.AddNumber "R"
|
||||
End With
|
||||
|
||||
Dim startCol As String: startCol = sheetConf("StartCol")
|
||||
Dim endCol As String: endCol = sheetConf("EndCol")
|
||||
Dim errorCol As String: errorCol = sheetConf("ErrorCol")
|
||||
Dim result As ValidationResult: Set result = engine.ValidateRow(ws, rowNum, lastDataRow)
|
||||
|
||||
Dim clearRange As Range: Set clearRange = ws.Range(ws.Cells(rowNum, startCol), ws.Cells(rowNum, endCol))
|
||||
clearRange.Interior.Color = vbWhite
|
||||
' === 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)
|
||||
|
||||
Dim errorCell As Range: Set errorCell = ws.Cells(rowNum, errorCol)
|
||||
' 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
|
||||
|
||||
' Check C column in the cache
|
||||
Dim m1Cache As Object: Set m1Cache = GetCache("M1")
|
||||
|
||||
' C column check
|
||||
checkResult = CheckRequired(ws, rowNum, 3, errorCol)
|
||||
If checkResult = False Then Exit Sub
|
||||
|
||||
Dim cValue As String: cValue = Trim(ws.Range("C" & rowNum).Value)
|
||||
If Not m1Cache.Exists(cValue) Then
|
||||
errorCell.Value = GetErrorMsg("E004", "C" & rowNum)
|
||||
ws.Range("C" & rowNum).Interior.Color = RGB(255, 0, 0)
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
' Check column required
|
||||
Dim colLetter As Variant
|
||||
For Each colLetter In Array("I", "J", "K", "L", "M")
|
||||
If Trim(ws.Range(colLetter & rowNum).Value) = "" Then
|
||||
errorCell.Value = GetErrorMsg("E002", colLetter & rowNum)
|
||||
ws.Range(colLetter & rowNum).Interior.Color = RGB(255, 0, 0)
|
||||
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
|
||||
Next colLetter
|
||||
|
||||
' Check column numeric (only if has value)
|
||||
Dim numericCols As Variant: numericCols = Array("L", "M", "N", "O", "P", "Q", "R")
|
||||
Dim col As Variant
|
||||
For Each col In numericCols
|
||||
Dim val As String: val = Trim(ws.Range(col & rowNum).Value & "")
|
||||
If val <> "" And Not IsNumeric(val) Then
|
||||
errorCell.Value = GetErrorMsg("E011", col & rowNum)
|
||||
ws.Range(col & rowNum).Interior.Color = RGB(255, 0, 0)
|
||||
Exit Sub
|
||||
End If
|
||||
Next col
|
||||
|
||||
Dim kenshuKbn As String: kenshuKbn = Trim(ws.Range("I" & rowNum).Value)
|
||||
|
||||
Dim cache As Object
|
||||
Dim requiredCols As Variant
|
||||
Dim equaledCols As Variant
|
||||
Dim emptyCols As Variant
|
||||
If kenshuKbn = "1" Then
|
||||
Set cache = GetCache(CACHE_T1)
|
||||
' must input
|
||||
equaledCols = Array("K")
|
||||
requiredCols = Array("N")
|
||||
emptyCols = Array("O", "P", "Q", "R")
|
||||
End If
|
||||
|
||||
If kenshuKbn = "2" Then
|
||||
Set cache = GetCache(CACHE_T2)
|
||||
' must input
|
||||
equaledCols = Array("K", "L", "M", "N", "O", "P", "Q")
|
||||
requiredCols = Array("N", "O", "P", "Q")
|
||||
emptyCols = Array("R")
|
||||
End If
|
||||
|
||||
If kenshuKbn = "3" Then
|
||||
Set cache = GetCache(CACHE_T3)
|
||||
' must input
|
||||
equaledCols = Array("K", "L", "M")
|
||||
requiredCols = Array()
|
||||
emptyCols = Array("N", "O", "P", "Q", "R")
|
||||
End If
|
||||
|
||||
' Check J column in the T1, T2, T3
|
||||
' code not exist check
|
||||
Dim code As String: code = Trim(ws.Range("J" & rowNum).Value)
|
||||
If Not cache.Exists(code) Then
|
||||
errorCell.Value = GetErrorMsg("E004", "J" & rowNum)
|
||||
ws.Range("J" & rowNum).Interior.Color = RGB(255, 0, 0)
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
Dim equaledCol As Variant
|
||||
Dim equaledIndex As Long
|
||||
For equaledIndex = LBound(equaledCols) To UBound(equaledCols)
|
||||
equaledCol = equaledCols(equaledIndex)
|
||||
' M2 value
|
||||
Dim equalValue As String: equalValue = Trim(ws.Range(equaledCol & rowNum).Value)
|
||||
If cache(code)(equaledIndex) <> equalValue Then
|
||||
errorCell.Value = GetErrorMsg("E004", equaledCol & rowNum)
|
||||
ws.Range(equaledCol & rowNum).Interior.Color = RGB(255, 0, 0)
|
||||
Exit Sub
|
||||
End If
|
||||
Next equaledIndex
|
||||
|
||||
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("E002", requiredCol & rowNum)
|
||||
ws.Range(requiredCol & rowNum).Interior.Color = RGB(255, 0, 0)
|
||||
Exit Sub
|
||||
End If
|
||||
Next requiredCol
|
||||
|
||||
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
|
||||
|
||||
' check Duplicate
|
||||
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)
|
||||
' kenshuKbn-specific: equaledCols, requiredCols, emptyCols
|
||||
Dim equaledCols As Variant
|
||||
Dim requiredCols As Variant
|
||||
Dim emptyCols As Variant
|
||||
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
|
||||
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
|
||||
|
||||
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
|
||||
' 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
|
||||
End If
|
||||
|
||||
' validate passed, clear error cell and setup backcolor
|
||||
errorCell.ClearContents
|
||||
Application.EnableEvents = False
|
||||
Call ChangeBackColor(rowNum)
|
||||
Application.EnableEvents = True
|
||||
Exit Sub
|
||||
|
||||
ErrHandler:
|
||||
lastErrorMsg = Err.Description
|
||||
SetLastErrorMsg Err.Description
|
||||
End Sub
|
||||
|
||||
' obtain T1/T2/T3 cache data, and update column K
|
||||
|
||||
@@ -31,5 +31,5 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
|
||||
Exit Sub
|
||||
|
||||
ErrHandler:
|
||||
lastErrorMsg = Err.Description
|
||||
SetLastErrorMsg Err.Description
|
||||
End Sub
|
||||
|
||||
@@ -32,5 +32,5 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
|
||||
Exit Sub
|
||||
|
||||
ErrHandler:
|
||||
lastErrorMsg = Err.Description
|
||||
SetLastErrorMsg Err.Description
|
||||
End Sub
|
||||
@@ -34,5 +34,5 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
|
||||
Exit Sub
|
||||
|
||||
ErrHandler:
|
||||
lastErrorMsg = Err.Description
|
||||
SetLastErrorMsg Err.Description
|
||||
End Sub
|
||||
|
||||
@@ -63,54 +63,24 @@ End Sub
|
||||
Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As Long)
|
||||
On Error GoTo ErrHandler
|
||||
|
||||
Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
|
||||
Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName)
|
||||
' Build engine: same order as original Validate
|
||||
Dim engine As ValidationRuleEngine: Set engine = New ValidationRuleEngine
|
||||
With engine
|
||||
.AddRequired "C" ' C: required
|
||||
.AddChar "C", 3 ' C: exact 3 chars
|
||||
.AddAlphanumeric "C" ' C: alphanumeric only
|
||||
.AddDuplicate "C" ' C: no duplicate in prior rows
|
||||
.AddRequired "D" ' D: required
|
||||
.AddVarchar "D", 80 ' D: max 80 chars
|
||||
.AddVarchar "E", 80 ' E: max 80 chars
|
||||
.AddVarchar "F", 80 ' F: max 80 chars
|
||||
.AddCheck01 "G" ' G: 0 or 1 only
|
||||
End With
|
||||
|
||||
Dim startCol As String: startCol = sheetConf("StartCol")
|
||||
Dim endCol As String: endCol = sheetConf("EndCol")
|
||||
Dim errorCol As String: errorCol = sheetConf("ErrorCol")
|
||||
Call engine.ValidateRow(ws, rowNum, lastDataRow)
|
||||
|
||||
' clear C~G columns background color
|
||||
Dim clearRange As Range: Set clearRange = ws.Range(ws.Cells(rowNum, startCol), ws.Cells(rowNum, endCol))
|
||||
clearRange.Interior.Color = vbWhite
|
||||
|
||||
Dim checkResult As Boolean: checkResult = False
|
||||
|
||||
' C column check
|
||||
checkResult = CheckRequired(ws, rowNum, 3, errorCol)
|
||||
If checkResult = False Then Exit Sub
|
||||
|
||||
checkResult = CheckChar(ws, rowNum, 3, 3, errorCol)
|
||||
If checkResult = False Then Exit Sub
|
||||
|
||||
checkResult = CheckAlphanumeric(ws, rowNum, 3, 3, errorCol)
|
||||
If checkResult = False Then Exit Sub
|
||||
|
||||
checkResult = CheckDuplicate(ws, rowNum, 3, errorCol)
|
||||
If checkResult = False Then Exit Sub
|
||||
|
||||
' D column check
|
||||
checkResult = CheckRequired(ws, rowNum, 4, errorCol)
|
||||
If checkResult = False Then Exit Sub
|
||||
|
||||
checkResult = CheckVarcharOver(ws, rowNum, 4, 80, errorCol)
|
||||
If checkResult = False Then Exit Sub
|
||||
|
||||
' E column check
|
||||
checkResult = CheckVarcharOver(ws, rowNum, 5, 80, errorCol)
|
||||
If checkResult = False Then Exit Sub
|
||||
|
||||
' F column check
|
||||
checkResult = CheckVarcharOver(ws, rowNum, 6, 80, errorCol)
|
||||
If checkResult = False Then Exit Sub
|
||||
|
||||
' G column check
|
||||
checkResult = Check01(ws, rowNum, 7, errorCol)
|
||||
If checkResult = False Then Exit Sub
|
||||
|
||||
ws.Cells(rowNum, errorCol).ClearContents
|
||||
Exit Sub
|
||||
|
||||
ErrHandler:
|
||||
lastErrorMsg = Err.Description
|
||||
SetLastErrorMsg Err.Description
|
||||
End Sub
|
||||
@@ -78,111 +78,34 @@ End Sub
|
||||
Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As Long)
|
||||
On Error GoTo ErrHandler
|
||||
|
||||
Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
|
||||
Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName)
|
||||
Dim engine As ValidationRuleEngine: Set engine = New ValidationRuleEngine
|
||||
With engine
|
||||
.AddRequired "C"
|
||||
.AddAlphanumeric "C"
|
||||
.AddDuplicate "C"
|
||||
.AddRequired "D"
|
||||
.AddVarchar "D", 80
|
||||
.AddVarchar "E", 80
|
||||
.AddVarchar "F", 80
|
||||
.AddCheck01 "G"
|
||||
.AddRequired "H"
|
||||
.AddNumber "H", 6
|
||||
.AddRequired "I"
|
||||
.AddNumber "I", 5
|
||||
.AddRequired "J"
|
||||
.AddNumber "J", 3
|
||||
.AddRequired "K"
|
||||
.AddNumber "K", 5
|
||||
.AddRequired "L"
|
||||
.AddNumber "L", 3
|
||||
.AddRequired "M"
|
||||
.AddNumber "M", 5
|
||||
End With
|
||||
|
||||
Dim startCol As String: startCol = sheetConf("StartCol")
|
||||
Dim endCol As String: endCol = sheetConf("EndCol")
|
||||
Dim errorCol As String: errorCol = sheetConf("ErrorCol")
|
||||
Call engine.ValidateRow(ws, rowNum, lastDataRow)
|
||||
|
||||
' clear C~M columns background color
|
||||
Dim clearRange As Range: Set clearRange = ws.Range(ws.Cells(rowNum, startCol), ws.Cells(rowNum, endCol))
|
||||
clearRange.Interior.Color = vbWhite
|
||||
|
||||
Dim checkResult As Boolean: checkResult = False
|
||||
|
||||
' C column check
|
||||
checkResult = CheckRequired(ws, rowNum, 3, errorCol)
|
||||
If checkResult = False Then Exit Sub
|
||||
|
||||
checkResult = CheckAlphanumeric(ws, rowNum, 3, 3, errorCol)
|
||||
If checkResult = False Then Exit Sub
|
||||
|
||||
checkResult = CheckDuplicate(ws, rowNum, 3, errorCol)
|
||||
If checkResult = False Then Exit Sub
|
||||
|
||||
' D column check
|
||||
checkResult = CheckRequired(ws, rowNum, 4, errorCol)
|
||||
If checkResult = False Then Exit Sub
|
||||
|
||||
checkResult = CheckVarcharOver(ws, rowNum, 4, 80, errorCol)
|
||||
If checkResult = False Then Exit Sub
|
||||
|
||||
' E column check
|
||||
checkResult = CheckVarcharOver(ws, rowNum, 5, 80, errorCol)
|
||||
If checkResult = False Then Exit Sub
|
||||
|
||||
' F column check
|
||||
checkResult = CheckVarcharOver(ws, rowNum, 6, 80, errorCol)
|
||||
If checkResult = False Then Exit Sub
|
||||
|
||||
' G column check
|
||||
checkResult = Check01(ws, rowNum, 7, errorCol)
|
||||
If checkResult = False Then Exit Sub
|
||||
|
||||
' H column check number
|
||||
checkResult = CheckRequired(ws, rowNum, 8, errorCol)
|
||||
If checkResult = False Then Exit Sub
|
||||
|
||||
checkResult = CheckNumber(ws, rowNum, 8, errorCol)
|
||||
If checkResult = False Then Exit Sub
|
||||
|
||||
checkResult = CheckNumberOver(ws, rowNum, 8, 6, errorCol)
|
||||
If checkResult = False Then Exit Sub
|
||||
|
||||
' I column check number
|
||||
checkResult = CheckRequired(ws, rowNum, 9, errorCol)
|
||||
If checkResult = False Then Exit Sub
|
||||
|
||||
checkResult = CheckNumber(ws, rowNum, 9, errorCol)
|
||||
If checkResult = False Then Exit Sub
|
||||
|
||||
checkResult = CheckNumberOver(ws, rowNum, 9, 5, errorCol)
|
||||
If checkResult = False Then Exit Sub
|
||||
|
||||
' J column check number
|
||||
checkResult = CheckRequired(ws, rowNum, 10, errorCol)
|
||||
If checkResult = False Then Exit Sub
|
||||
|
||||
checkResult = CheckNumber(ws, rowNum, 10, errorCol)
|
||||
If checkResult = False Then Exit Sub
|
||||
|
||||
checkResult = CheckNumberOver(ws, rowNum, 10, 3, errorCol)
|
||||
If checkResult = False Then Exit Sub
|
||||
|
||||
' K column check number
|
||||
checkResult = CheckRequired(ws, rowNum, 11, errorCol)
|
||||
If checkResult = False Then Exit Sub
|
||||
|
||||
checkResult = CheckNumber(ws, rowNum, 11, errorCol)
|
||||
If checkResult = False Then Exit Sub
|
||||
|
||||
checkResult = CheckNumberOver(ws, rowNum, 11, 5, errorCol)
|
||||
If checkResult = False Then Exit Sub
|
||||
|
||||
' L column check number
|
||||
checkResult = CheckRequired(ws, rowNum, 12, errorCol)
|
||||
If checkResult = False Then Exit Sub
|
||||
|
||||
checkResult = CheckNumber(ws, rowNum, 12, errorCol)
|
||||
If checkResult = False Then Exit Sub
|
||||
|
||||
checkResult = CheckNumberOver(ws, rowNum, 12, 3, errorCol)
|
||||
If checkResult = False Then Exit Sub
|
||||
|
||||
' M column check number
|
||||
checkResult = CheckRequired(ws, rowNum, 13, errorCol)
|
||||
If checkResult = False Then Exit Sub
|
||||
|
||||
checkResult = CheckNumber(ws, rowNum, 13, errorCol)
|
||||
If checkResult = False Then Exit Sub
|
||||
|
||||
checkResult = CheckNumberOver(ws, rowNum, 13, 5, errorCol)
|
||||
If checkResult = False Then Exit Sub
|
||||
|
||||
ws.Cells(rowNum, errorCol).ClearContents
|
||||
Exit Sub
|
||||
|
||||
ErrHandler:
|
||||
lastErrorMsg = Err.Description
|
||||
SetLastErrorMsg Err.Description
|
||||
End Sub
|
||||
@@ -63,74 +63,27 @@ End Sub
|
||||
Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As Long)
|
||||
On Error GoTo ErrHandler
|
||||
|
||||
Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
|
||||
Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName)
|
||||
Dim engine As ValidationRuleEngine: Set engine = New ValidationRuleEngine
|
||||
With engine
|
||||
.AddRequired "C"
|
||||
.AddChar "C", 3
|
||||
.AddAlphanumeric "C"
|
||||
.AddDuplicate "C"
|
||||
.AddRequired "D"
|
||||
.AddVarchar "D", 80
|
||||
.AddVarchar "E", 80
|
||||
.AddVarchar "F", 80
|
||||
.AddCheck01 "G"
|
||||
.AddRequired "H"
|
||||
.AddNumber "H", 6
|
||||
.AddRequired "I"
|
||||
.AddNumber "I", 6
|
||||
End With
|
||||
|
||||
Dim startCol As String: startCol = sheetConf("StartCol")
|
||||
Dim endCol As String: endCol = sheetConf("EndCol")
|
||||
Dim errorCol As String: errorCol = sheetConf("ErrorCol")
|
||||
Call engine.ValidateRow(ws, rowNum, lastDataRow)
|
||||
|
||||
' clear C~I columns background color
|
||||
Dim clearRange As Range: Set clearRange = ws.Range(ws.Cells(rowNum, startCol), ws.Cells(rowNum, endCol))
|
||||
clearRange.Interior.Color = vbWhite
|
||||
|
||||
Dim checkResult As Boolean: checkResult = False
|
||||
|
||||
' C column check
|
||||
checkResult = CheckRequired(ws, rowNum, 3, errorCol)
|
||||
If checkResult = False Then Exit Sub
|
||||
|
||||
checkResult = CheckChar(ws, rowNum, 3, 3, errorCol)
|
||||
If checkResult = False Then Exit Sub
|
||||
|
||||
checkResult = CheckAlphanumeric(ws, rowNum, 3, 3, errorCol)
|
||||
If checkResult = False Then Exit Sub
|
||||
|
||||
checkResult = CheckDuplicate(ws, rowNum, 3, errorCol)
|
||||
If checkResult = False Then Exit Sub
|
||||
|
||||
' D column check
|
||||
checkResult = CheckRequired(ws, rowNum, 4, errorCol)
|
||||
If checkResult = False Then Exit Sub
|
||||
|
||||
checkResult = CheckVarcharOver(ws, rowNum, 4, 80, errorCol)
|
||||
If checkResult = False Then Exit Sub
|
||||
|
||||
' E column check
|
||||
checkResult = CheckVarcharOver(ws, rowNum, 5, 80, errorCol)
|
||||
If checkResult = False Then Exit Sub
|
||||
|
||||
' F column check
|
||||
checkResult = CheckVarcharOver(ws, rowNum, 6, 80, errorCol)
|
||||
If checkResult = False Then Exit Sub
|
||||
|
||||
' G column check
|
||||
checkResult = Check01(ws, rowNum, 7, errorCol)
|
||||
If checkResult = False Then Exit Sub
|
||||
|
||||
' H column check number
|
||||
checkResult = CheckRequired(ws, rowNum, 8, errorCol)
|
||||
If checkResult = False Then Exit Sub
|
||||
|
||||
checkResult = CheckNumber(ws, rowNum, 8, errorCol)
|
||||
If checkResult = False Then Exit Sub
|
||||
|
||||
checkResult = CheckNumberOver(ws, rowNum, 8, 6, errorCol)
|
||||
If checkResult = False Then Exit Sub
|
||||
|
||||
' I column check number
|
||||
checkResult = CheckRequired(ws, rowNum, 9, errorCol)
|
||||
If checkResult = False Then Exit Sub
|
||||
|
||||
checkResult = CheckNumber(ws, rowNum, 9, errorCol)
|
||||
If checkResult = False Then Exit Sub
|
||||
|
||||
checkResult = CheckNumberOver(ws, rowNum, 9, 6, errorCol)
|
||||
If checkResult = False Then Exit Sub
|
||||
|
||||
ws.Cells(rowNum, errorCol).ClearContents
|
||||
Exit Sub
|
||||
|
||||
ErrHandler:
|
||||
lastErrorMsg = Err.Description
|
||||
SetLastErrorMsg Err.Description
|
||||
End Sub
|
||||
@@ -63,62 +63,25 @@ End Sub
|
||||
Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As Long)
|
||||
On Error GoTo ErrHandler
|
||||
|
||||
Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
|
||||
Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName)
|
||||
Dim engine As ValidationRuleEngine: Set engine = New ValidationRuleEngine
|
||||
With engine
|
||||
.AddRequired "C"
|
||||
.AddChar "C", 3
|
||||
.AddAlphanumeric "C"
|
||||
.AddDuplicate "C"
|
||||
.AddRequired "D"
|
||||
.AddVarchar "D", 80
|
||||
.AddVarchar "E", 80
|
||||
.AddVarchar "F", 80
|
||||
.AddVarchar "G", 80
|
||||
.AddCheck01 "H"
|
||||
.AddVarchar "I", 80
|
||||
End With
|
||||
|
||||
Dim startCol As String: startCol = sheetConf("StartCol")
|
||||
Dim endCol As String: endCol = sheetConf("EndCol")
|
||||
Dim errorCol As String: errorCol = sheetConf("ErrorCol")
|
||||
Call engine.ValidateRow(ws, rowNum, lastDataRow)
|
||||
|
||||
' clear C~I columns background color
|
||||
Dim clearRange As Range: Set clearRange = ws.Range(ws.Cells(rowNum, startCol), ws.Cells(rowNum, endCol))
|
||||
clearRange.Interior.Color = vbWhite
|
||||
|
||||
Dim checkResult As Boolean: checkResult = False
|
||||
|
||||
' C column check
|
||||
checkResult = CheckRequired(ws, rowNum, 3, errorCol)
|
||||
If checkResult = False Then Exit Sub
|
||||
|
||||
checkResult = CheckChar(ws, rowNum, 3, 3, errorCol)
|
||||
If checkResult = False Then Exit Sub
|
||||
|
||||
checkResult = CheckAlphanumeric(ws, rowNum, 3, 3, errorCol)
|
||||
If checkResult = False Then Exit Sub
|
||||
|
||||
checkResult = CheckDuplicate(ws, rowNum, 3, errorCol)
|
||||
If checkResult = False Then Exit Sub
|
||||
|
||||
' D column check
|
||||
checkResult = CheckRequired(ws, rowNum, 4, errorCol)
|
||||
If checkResult = False Then Exit Sub
|
||||
|
||||
checkResult = CheckVarcharOver(ws, rowNum, 4, 80, errorCol)
|
||||
If checkResult = False Then Exit Sub
|
||||
|
||||
' E column check
|
||||
checkResult = CheckVarcharOver(ws, rowNum, 5, 80, errorCol)
|
||||
If checkResult = False Then Exit Sub
|
||||
|
||||
' F column check
|
||||
checkResult = CheckVarcharOver(ws, rowNum, 6, 80, errorCol)
|
||||
If checkResult = False Then Exit Sub
|
||||
|
||||
' G column check
|
||||
checkResult = CheckVarcharOver(ws, rowNum, 7, 80, errorCol)
|
||||
If checkResult = False Then Exit Sub
|
||||
|
||||
' H column check
|
||||
checkResult = Check01(ws, rowNum, 8, errorCol)
|
||||
If checkResult = False Then Exit Sub
|
||||
|
||||
' I column check
|
||||
checkResult = CheckVarcharOver(ws, rowNum, 9, 80, errorCol)
|
||||
If checkResult = False Then Exit Sub
|
||||
|
||||
ws.Cells(rowNum, errorCol).ClearContents
|
||||
Exit Sub
|
||||
|
||||
ErrHandler:
|
||||
lastErrorMsg = Err.Description
|
||||
SetLastErrorMsg Err.Description
|
||||
End Sub
|
||||
@@ -63,54 +63,23 @@ End Sub
|
||||
Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As Long)
|
||||
On Error GoTo ErrHandler
|
||||
|
||||
Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
|
||||
Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName)
|
||||
Dim engine As ValidationRuleEngine: Set engine = New ValidationRuleEngine
|
||||
With engine
|
||||
.AddRequired "C"
|
||||
.AddChar "C", 1
|
||||
.AddAlphanumeric "C"
|
||||
.AddDuplicate "C"
|
||||
.AddRequired "D"
|
||||
.AddVarchar "D", 80
|
||||
.AddVarchar "E", 80
|
||||
.AddVarchar "F", 80
|
||||
.AddCheck01 "G"
|
||||
End With
|
||||
|
||||
Dim startCol As String: startCol = sheetConf("StartCol")
|
||||
Dim endCol As String: endCol = sheetConf("EndCol")
|
||||
Dim errorCol As String: errorCol = sheetConf("ErrorCol")
|
||||
Call engine.ValidateRow(ws, rowNum, lastDataRow)
|
||||
|
||||
' clear C~G columns background color
|
||||
Dim clearRange As Range: Set clearRange = ws.Range(ws.Cells(rowNum, startCol), ws.Cells(rowNum, endCol))
|
||||
clearRange.Interior.Color = vbWhite
|
||||
|
||||
Dim checkResult As Boolean: checkResult = False
|
||||
|
||||
' C column check
|
||||
checkResult = CheckRequired(ws, rowNum, 3, errorCol)
|
||||
If checkResult = False Then Exit Sub
|
||||
|
||||
checkResult = CheckChar(ws, rowNum, 3, 1, errorCol)
|
||||
If checkResult = False Then Exit Sub
|
||||
|
||||
checkResult = CheckAlphanumeric(ws, rowNum, 3, 1, errorCol)
|
||||
If checkResult = False Then Exit Sub
|
||||
|
||||
checkResult = CheckDuplicate(ws, rowNum, 3, errorCol)
|
||||
If checkResult = False Then Exit Sub
|
||||
|
||||
' D column check
|
||||
checkResult = CheckRequired(ws, rowNum, 4, errorCol)
|
||||
If checkResult = False Then Exit Sub
|
||||
|
||||
checkResult = CheckVarcharOver(ws, rowNum, 4, 80, errorCol)
|
||||
If checkResult = False Then Exit Sub
|
||||
|
||||
' E column check
|
||||
checkResult = CheckVarcharOver(ws, rowNum, 5, 80, errorCol)
|
||||
If checkResult = False Then Exit Sub
|
||||
|
||||
' F column check
|
||||
checkResult = CheckVarcharOver(ws, rowNum, 6, 80, errorCol)
|
||||
If checkResult = False Then Exit Sub
|
||||
|
||||
' G column check
|
||||
checkResult = Check01(ws, rowNum, 7, errorCol)
|
||||
If checkResult = False Then Exit Sub
|
||||
|
||||
ws.Cells(rowNum, errorCol).ClearContents
|
||||
Exit Sub
|
||||
|
||||
ErrHandler:
|
||||
lastErrorMsg = Err.Description
|
||||
SetLastErrorMsg Err.Description
|
||||
End Sub
|
||||
@@ -63,58 +63,24 @@ End Sub
|
||||
Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As Long)
|
||||
On Error GoTo ErrHandler
|
||||
|
||||
Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
|
||||
Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName)
|
||||
Dim engine As ValidationRuleEngine: Set engine = New ValidationRuleEngine
|
||||
With engine
|
||||
.AddRequired "C"
|
||||
.AddChar "C", 2
|
||||
.AddAlphanumeric "C"
|
||||
.AddDuplicate "C"
|
||||
.AddRequired "D"
|
||||
.AddVarchar "D", 80
|
||||
.AddVarchar "E", 80
|
||||
.AddVarchar "F", 80
|
||||
.AddCheck01 "G"
|
||||
.AddVarchar "H", 80
|
||||
End With
|
||||
|
||||
Dim startCol As String: startCol = sheetConf("StartCol")
|
||||
Dim endCol As String: endCol = sheetConf("EndCol")
|
||||
Dim errorCol As String: errorCol = sheetConf("ErrorCol")
|
||||
Call engine.ValidateRow(ws, rowNum, lastDataRow)
|
||||
|
||||
' clear C~H columns background color
|
||||
Dim clearRange As Range: Set clearRange = ws.Range(ws.Cells(rowNum, startCol), ws.Cells(rowNum, endCol))
|
||||
clearRange.Interior.Color = vbWhite
|
||||
|
||||
Dim checkResult As Boolean: checkResult = False
|
||||
|
||||
' C column check
|
||||
checkResult = CheckRequired(ws, rowNum, 3, errorCol)
|
||||
If checkResult = False Then Exit Sub
|
||||
|
||||
checkResult = CheckChar(ws, rowNum, 3, 2, errorCol)
|
||||
If checkResult = False Then Exit Sub
|
||||
|
||||
checkResult = CheckAlphanumeric(ws, rowNum, 3, 2, errorCol)
|
||||
If checkResult = False Then Exit Sub
|
||||
|
||||
checkResult = CheckDuplicate(ws, rowNum, 3, errorCol)
|
||||
If checkResult = False Then Exit Sub
|
||||
|
||||
' D column check
|
||||
checkResult = CheckRequired(ws, rowNum, 4, errorCol)
|
||||
If checkResult = False Then Exit Sub
|
||||
|
||||
checkResult = CheckVarcharOver(ws, rowNum, 4, 80, errorCol)
|
||||
If checkResult = False Then Exit Sub
|
||||
|
||||
' E column check
|
||||
checkResult = CheckVarcharOver(ws, rowNum, 5, 80, errorCol)
|
||||
If checkResult = False Then Exit Sub
|
||||
|
||||
' F column check
|
||||
checkResult = CheckVarcharOver(ws, rowNum, 6, 80, errorCol)
|
||||
If checkResult = False Then Exit Sub
|
||||
|
||||
' G column check
|
||||
checkResult = Check01(ws, rowNum, 7, errorCol)
|
||||
If checkResult = False Then Exit Sub
|
||||
|
||||
' H column check
|
||||
checkResult = CheckVarcharOver(ws, rowNum, 8, 80, errorCol)
|
||||
If checkResult = False Then Exit Sub
|
||||
|
||||
ws.Cells(rowNum, errorCol).ClearContents
|
||||
Exit Sub
|
||||
|
||||
ErrHandler:
|
||||
lastErrorMsg = Err.Description
|
||||
SetLastErrorMsg Err.Description
|
||||
End Sub
|
||||
@@ -63,58 +63,25 @@ End Sub
|
||||
Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As Long)
|
||||
On Error GoTo ErrHandler
|
||||
|
||||
Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
|
||||
Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName)
|
||||
Dim engine As ValidationRuleEngine: Set engine = New ValidationRuleEngine
|
||||
With engine
|
||||
.AddRequired "C"
|
||||
.AddChar "C", 6
|
||||
.AddAlphanumeric "C"
|
||||
.AddDuplicate "C"
|
||||
.AddRequired "D"
|
||||
.AddVarchar "D", 80
|
||||
.AddVarchar "E", 80
|
||||
.AddRequired "F"
|
||||
.AddVarchar "F", 80
|
||||
.AddVarchar "G", 80
|
||||
.AddCheck01 "H"
|
||||
End With
|
||||
|
||||
Dim startCol As String: startCol = sheetConf("StartCol")
|
||||
Dim endCol As String: endCol = sheetConf("EndCol")
|
||||
Dim errorCol As String: errorCol = sheetConf("ErrorCol")
|
||||
Call engine.ValidateRow(ws, rowNum, lastDataRow)
|
||||
|
||||
' clear C~H columns background color
|
||||
Dim clearRange As Range: Set clearRange = ws.Range(ws.Cells(rowNum, startCol), ws.Cells(rowNum, endCol))
|
||||
clearRange.Interior.Color = vbWhite
|
||||
|
||||
Dim checkResult As Boolean: checkResult = False
|
||||
|
||||
' C column check
|
||||
checkResult = CheckRequired(ws, rowNum, 3, errorCol)
|
||||
If checkResult = False Then Exit Sub
|
||||
|
||||
checkResult = CheckChar(ws, rowNum, 3, 6, errorCol)
|
||||
If checkResult = False Then Exit Sub
|
||||
|
||||
checkResult = CheckAlphanumeric(ws, rowNum, 3, 6, errorCol)
|
||||
If checkResult = False Then Exit Sub
|
||||
|
||||
checkResult = CheckDuplicate(ws, rowNum, 3, errorCol)
|
||||
If checkResult = False Then Exit Sub
|
||||
|
||||
' D column check
|
||||
checkResult = CheckRequired(ws, rowNum, 4, errorCol)
|
||||
If checkResult = False Then Exit Sub
|
||||
|
||||
checkResult = CheckVarcharOver(ws, rowNum, 4, 80, errorCol)
|
||||
If checkResult = False Then Exit Sub
|
||||
|
||||
' E column check
|
||||
checkResult = CheckVarcharOver(ws, rowNum, 5, 80, errorCol)
|
||||
If checkResult = False Then Exit Sub
|
||||
|
||||
' F column check
|
||||
checkResult = CheckVarcharOver(ws, rowNum, 6, 80, errorCol)
|
||||
If checkResult = False Then Exit Sub
|
||||
|
||||
' G column check
|
||||
checkResult = CheckVarcharOver(ws, rowNum, 7, 80, errorCol)
|
||||
If checkResult = False Then Exit Sub
|
||||
|
||||
' H column check
|
||||
checkResult = Check01(ws, rowNum, 8, errorCol)
|
||||
If checkResult = False Then Exit Sub
|
||||
|
||||
ws.Cells(rowNum, errorCol).ClearContents
|
||||
Exit Sub
|
||||
|
||||
ErrHandler:
|
||||
lastErrorMsg = Err.Description
|
||||
SetLastErrorMsg Err.Description
|
||||
End Sub
|
||||
31
src/sh/tuk/validation/ValidationResult.cls
Normal file
31
src/sh/tuk/validation/ValidationResult.cls
Normal file
@@ -0,0 +1,31 @@
|
||||
VERSION 1.0 CLASS
|
||||
BEGIN
|
||||
MultiUse = -1 'True
|
||||
END
|
||||
Attribute VB_Name = "ValidationResult"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = False
|
||||
Attribute VB_PredeclaredId = False
|
||||
Attribute VB_Exposed = False
|
||||
Option Explicit
|
||||
|
||||
Public Passed As Boolean
|
||||
Public ErrorCode As String
|
||||
Public ErrorCol As Long
|
||||
Public ErrorRow As Long
|
||||
Public Extra As String ' extra info per rule type (e.g. duplicate value for ERR_DUPLICATE)
|
||||
|
||||
Private Sub Class_Initialize()
|
||||
Passed = True
|
||||
End Sub
|
||||
|
||||
' ============================================================
|
||||
' Mark this result as a failure.
|
||||
' ============================================================
|
||||
Public Sub SetFail(errorCode As String, errorCol As Long, errorRow As Long, Optional extra As String = "")
|
||||
Passed = False
|
||||
Me.ErrorCode = errorCode
|
||||
Me.ErrorCol = errorCol
|
||||
Me.ErrorRow = errorRow
|
||||
Me.Extra = extra
|
||||
End Sub
|
||||
161
src/sh/tuk/validation/ValidationRule.cls
Normal file
161
src/sh/tuk/validation/ValidationRule.cls
Normal file
@@ -0,0 +1,161 @@
|
||||
VERSION 1.0 CLASS
|
||||
BEGIN
|
||||
MultiUse = -1 'True
|
||||
END
|
||||
Attribute VB_Name = "ValidationRule"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = False
|
||||
Attribute VB_PredeclaredId = False
|
||||
Attribute VB_Exposed = False
|
||||
Option Explicit
|
||||
|
||||
' --- Properties ---
|
||||
' RuleKind (ValRule_*), ColIndex, ColLetter, CacheName, MinVal, MaxVal,
|
||||
' CharLen, VarcharLen, NumberDigits, NumberDec, StartRow
|
||||
Public RuleKind As Long
|
||||
Public ColIndex As Long
|
||||
Public ColLetter As String
|
||||
Public CacheName As String
|
||||
Public MinVal As Double
|
||||
Public MaxVal As Double
|
||||
Public CharLen As Long
|
||||
Public VarcharLen As Long
|
||||
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.
|
||||
' ============================================================
|
||||
Public Function ValidateRow(ws As Worksheet, rowNum As Long, Optional lastDataRow As Long = 0) As ValidationResult
|
||||
Dim result As ValidationResult: Set result = New ValidationResult
|
||||
|
||||
Select Case RuleKind
|
||||
|
||||
Case ValRule_Required
|
||||
If Trim(ws.Cells(rowNum, ColIndex).Value & "") = "" Then
|
||||
result.SetFail ERR_REQUIRED, ColIndex, rowNum
|
||||
End If
|
||||
|
||||
Case ValRule_Date
|
||||
Dim dateVal As String: dateVal = Trim(ws.Cells(rowNum, ColIndex).Value & "")
|
||||
If dateVal <> "" Then
|
||||
If Len(dateVal) <> 10 Or Mid(dateVal, 5, 1) <> "-" Or Mid(dateVal, 8, 1) <> "-" Then
|
||||
result.SetFail ERR_INVALID, ColIndex, rowNum
|
||||
End If
|
||||
End If
|
||||
|
||||
Case ValRule_Number
|
||||
Dim numVal As String: numVal = Trim(ws.Cells(rowNum, ColIndex).Value & "")
|
||||
If numVal <> "" Then
|
||||
If Not IsNumeric(numVal) Then
|
||||
result.SetFail ERR_INVALID, ColIndex, rowNum
|
||||
ElseIf NumberDigits > 0 Or NumberDec > 0 Then
|
||||
Dim dotPos As Long: dotPos = InStr(numVal, ".")
|
||||
Dim intPart As String
|
||||
Dim decPart As String
|
||||
If dotPos > 0 Then
|
||||
intPart = Left(numVal, dotPos - 1)
|
||||
decPart = Mid(numVal, dotPos + 1)
|
||||
Else
|
||||
intPart = numVal
|
||||
decPart = ""
|
||||
End If
|
||||
If Left(intPart, 1) = "-" Then intPart = Mid(intPart, 2)
|
||||
If Len(intPart) = 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
|
||||
result.SetFail ERR_NUMDIGITS, ColIndex, rowNum, "Number(" & NumberDigits & ", " & NumberDec & ")"
|
||||
End If
|
||||
End If
|
||||
End If
|
||||
|
||||
Case ValRule_CodeSelect
|
||||
Dim codeVal As String: codeVal = Trim(ws.Cells(rowNum, ColIndex).Value & "")
|
||||
If codeVal <> "" Then
|
||||
Dim cache As Object: Set cache = GetCache(CacheName)
|
||||
Dim code As String: code = GetCode(codeVal)
|
||||
If Not cache.Exists(code) Then
|
||||
result.SetFail ERR_NOT_EXIST, ColIndex, rowNum
|
||||
End If
|
||||
End If
|
||||
|
||||
Case ValRule_Range
|
||||
Dim rangeVal As String: rangeVal = Trim(ws.Cells(rowNum, ColIndex).Value & "")
|
||||
If rangeVal <> "" Then
|
||||
If Not IsNumeric(rangeVal) Then
|
||||
result.SetFail ERR_INVALID, ColIndex, rowNum
|
||||
ElseIf CDbl(rangeVal) < MinVal Or CDbl(rangeVal) > MaxVal Then
|
||||
result.SetFail ERR_RANGE, ColIndex, rowNum
|
||||
End If
|
||||
End If
|
||||
|
||||
Case ValRule_Duplicate
|
||||
Dim dupVal As String: dupVal = Trim(ws.Cells(rowNum, ColIndex).Value & "")
|
||||
If dupVal <> "" Then
|
||||
Dim upperRow As Long: upperRow = rowNum - 1
|
||||
Dim firstRow As Long: firstRow = IIf(StartRow > 0, StartRow, 7)
|
||||
Dim i As Long
|
||||
For i = firstRow To upperRow
|
||||
If Trim(ws.Cells(i, ColIndex).Value & "") = dupVal Then
|
||||
result.SetFail ERR_DUPLICATE, ColIndex, rowNum, dupVal
|
||||
Exit For
|
||||
End If
|
||||
Next i
|
||||
End If
|
||||
|
||||
Case ValRule_Char
|
||||
Dim charVal As String: charVal = Trim(ws.Cells(rowNum, ColIndex).Value & "")
|
||||
If charVal <> "" And Len(charVal) <> CharLen Then
|
||||
result.SetFail ERR_CHARLEN, ColIndex, rowNum, CStr(CharLen)
|
||||
End If
|
||||
|
||||
Case ValRule_Varchar
|
||||
Dim varcharVal As String: varcharVal = Trim(ws.Cells(rowNum, ColIndex).Value & "")
|
||||
If varcharVal <> "" And Len(varcharVal) > VarcharLen Then
|
||||
result.SetFail ERR_VARLEN, ColIndex, rowNum, CStr(VarcharLen)
|
||||
End If
|
||||
|
||||
Case ValRule_Check01
|
||||
Dim chk01Val As String: chk01Val = Trim(ws.Cells(rowNum, ColIndex).Value & "")
|
||||
If chk01Val <> "" Then
|
||||
If Len(chk01Val) <> 1 Or (chk01Val <> "0" And chk01Val <> "1") Then
|
||||
result.SetFail ERR_CHECK01, ColIndex, rowNum
|
||||
End If
|
||||
End If
|
||||
|
||||
Case ValRule_Alphanumeric
|
||||
Dim alphaVal As String: alphaVal = Trim(ws.Cells(rowNum, ColIndex).Value & "")
|
||||
If alphaVal <> "" Then
|
||||
Dim j As Long
|
||||
Dim ch2 As String
|
||||
For j = 1 To Len(alphaVal)
|
||||
ch2 = Mid(alphaVal, j, 1)
|
||||
If Not ((ch2 >= "0" And ch2 <= "9") Or (ch2 >= "A" And ch2 <= "Z") Or (ch2 >= "a" And ch2 <= "z")) Then
|
||||
result.SetFail ERR_INVALID, ColIndex, rowNum
|
||||
Exit For
|
||||
End If
|
||||
Next j
|
||||
End If
|
||||
|
||||
Case ValRule_Custom
|
||||
' Reserved for future extension
|
||||
|
||||
End Select
|
||||
|
||||
Set ValidateRow = result
|
||||
End Function
|
||||
180
src/sh/tuk/validation/ValidationRuleEngine.cls
Normal file
180
src/sh/tuk/validation/ValidationRuleEngine.cls
Normal file
@@ -0,0 +1,180 @@
|
||||
VERSION 1.0 CLASS
|
||||
BEGIN
|
||||
MultiUse = -1 'True
|
||||
END
|
||||
Attribute VB_Name = "ValidationRuleEngine"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = False
|
||||
Attribute VB_PredeclaredId = False
|
||||
Attribute VB_Exposed = False
|
||||
Option Explicit
|
||||
|
||||
Private pRules As VBA.Collection
|
||||
|
||||
Private Sub Class_Initialize()
|
||||
Set pRules = New VBA.Collection
|
||||
End Sub
|
||||
|
||||
' ============================================================
|
||||
' Add a Required rule directly (convenience method).
|
||||
' ============================================================
|
||||
Public Sub AddRequired(ByVal colIndex As String)
|
||||
Dim r As ValidationRule: Set r = New ValidationRule
|
||||
r.RuleKind = ValRule_Required
|
||||
r.ColIndex = IIf(IsNumeric(colIndex), colIndex, ColNum(CStr(colIndex)))
|
||||
pRules.Add r
|
||||
Set r = Nothing
|
||||
End Sub
|
||||
|
||||
Public Sub AddDate(colIndex As Variant)
|
||||
Dim r As ValidationRule: Set r = New ValidationRule
|
||||
r.RuleKind = ValRule_Date
|
||||
r.ColIndex = IIf(IsNumeric(colIndex), colIndex, ColNum(CStr(colIndex)))
|
||||
pRules.Add r
|
||||
Set r = Nothing
|
||||
End Sub
|
||||
|
||||
Public Sub AddNumber(colIndex As Variant, Optional totalDigits As Long = 0, Optional decimalDigits As Long = 0)
|
||||
Dim r As ValidationRule: Set r = New ValidationRule
|
||||
r.RuleKind = ValRule_Number
|
||||
r.ColIndex = IIf(IsNumeric(colIndex), colIndex, ColNum(CStr(colIndex)))
|
||||
If totalDigits > 0 Then r.NumberDigits = totalDigits
|
||||
If decimalDigits > 0 Then r.NumberDec = decimalDigits
|
||||
pRules.Add r
|
||||
Set r = Nothing
|
||||
End Sub
|
||||
|
||||
Public Sub AddCodeSelect(colIndex As Variant, cacheName As String)
|
||||
Dim r As ValidationRule: Set r = New ValidationRule
|
||||
r.RuleKind = ValRule_CodeSelect
|
||||
r.ColIndex = IIf(IsNumeric(colIndex), colIndex, ColNum(CStr(colIndex)))
|
||||
r.CacheName = cacheName
|
||||
pRules.Add r
|
||||
Set r = Nothing
|
||||
End Sub
|
||||
|
||||
Public Sub AddRange(colIndex As Variant, minVal As Double, maxVal As Double)
|
||||
Dim r As ValidationRule: Set r = New ValidationRule
|
||||
r.RuleKind = ValRule_Range
|
||||
r.ColIndex = IIf(IsNumeric(colIndex), colIndex, ColNum(CStr(colIndex)))
|
||||
r.MinVal = minVal
|
||||
r.MaxVal = maxVal
|
||||
pRules.Add r
|
||||
Set r = Nothing
|
||||
End Sub
|
||||
|
||||
Public Sub AddDuplicate(colIndex As Variant, Optional firstRow As Long = 0)
|
||||
Dim r As ValidationRule: Set r = New ValidationRule
|
||||
r.RuleKind = ValRule_Duplicate
|
||||
r.ColIndex = IIf(IsNumeric(colIndex), colIndex, ColNum(CStr(colIndex)))
|
||||
If firstRow > 0 Then r.StartRow = firstRow
|
||||
pRules.Add r
|
||||
Set r = Nothing
|
||||
End Sub
|
||||
|
||||
Public Sub AddChar(colIndex As Variant, charLen As Long)
|
||||
Dim r As ValidationRule: Set r = New ValidationRule
|
||||
r.RuleKind = ValRule_Char
|
||||
r.ColIndex = IIf(IsNumeric(colIndex), colIndex, ColNum(CStr(colIndex)))
|
||||
r.CharLen = charLen
|
||||
pRules.Add r
|
||||
Set r = Nothing
|
||||
End Sub
|
||||
|
||||
Public Sub AddVarchar(colIndex As Variant, maxLen As Long)
|
||||
Dim r As ValidationRule: Set r = New ValidationRule
|
||||
r.RuleKind = ValRule_Varchar
|
||||
r.ColIndex = IIf(IsNumeric(colIndex), colIndex, ColNum(CStr(colIndex)))
|
||||
r.VarcharLen = maxLen
|
||||
pRules.Add r
|
||||
Set r = Nothing
|
||||
End Sub
|
||||
|
||||
Public Sub AddCheck01(colIndex As Variant)
|
||||
Dim r As ValidationRule: Set r = New ValidationRule
|
||||
r.RuleKind = ValRule_Check01
|
||||
r.ColIndex = IIf(IsNumeric(colIndex), colIndex, ColNum(CStr(colIndex)))
|
||||
pRules.Add r
|
||||
Set r = Nothing
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
Public Sub AddAlphanumeric(colIndex As Variant)
|
||||
Dim r As ValidationRule: Set r = New ValidationRule
|
||||
r.RuleKind = ValRule_Alphanumeric
|
||||
r.ColIndex = IIf(IsNumeric(colIndex), colIndex, ColNum(CStr(colIndex)))
|
||||
pRules.Add r
|
||||
Set r = Nothing
|
||||
End Sub
|
||||
|
||||
' ============================================================
|
||||
' Run all rules against the given row.
|
||||
' Clears row background at start, outputs error on failure.
|
||||
' lastDataRow is required when Duplicate rules are registered.
|
||||
' Returns Nothing if all rules pass.
|
||||
' ============================================================
|
||||
Public Function ValidateRow(ws As Worksheet, rowNum As Long, Optional lastDataRow As Long = 0) As ValidationResult
|
||||
' Clear row background
|
||||
Call ClearRowBg(ws, rowNum)
|
||||
|
||||
Dim r As ValidationRule
|
||||
Dim result As ValidationResult
|
||||
|
||||
For Each r In pRules
|
||||
Set result = r.ValidateRow(ws, rowNum, lastDataRow)
|
||||
If Not result.Passed Then
|
||||
Call OutputError(ws, rowNum, result)
|
||||
Set ValidateRow = result
|
||||
Exit Function
|
||||
End If
|
||||
Next r
|
||||
|
||||
' All passed
|
||||
Set ValidateRow = New ValidationResult
|
||||
End Function
|
||||
|
||||
' ============================================================
|
||||
' Number of rules registered.
|
||||
' ============================================================
|
||||
Public Property Get RuleCount() As Long
|
||||
RuleCount = pRules.Count
|
||||
End Property
|
||||
|
||||
' ============================================================
|
||||
' Clear background color for the given row.
|
||||
' Uses the colIndex of each registered rule to build the range.
|
||||
' Call this before running ValidateRow.
|
||||
' ============================================================
|
||||
Public Sub ClearRowBg(ws As Worksheet, rowNum As Long)
|
||||
Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
|
||||
Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName)
|
||||
Dim errorCol As Long: errorCol = ColNum(CStr(sheetConf("ErrorCol")))
|
||||
Dim endCol As Long: endCol = ColNum(CStr(sheetConf("EndCol")))
|
||||
|
||||
Dim clearRange As Range
|
||||
Set clearRange = ws.Range(ws.Cells(rowNum, errorCol), ws.Cells(rowNum, endCol))
|
||||
clearRange.Interior.Color = vbWhite
|
||||
ws.Cells(rowNum, errorCol).ClearContents
|
||||
End Sub
|
||||
|
||||
' ============================================================
|
||||
' Write error message and highlight the failed cell.
|
||||
' Resolves errorCol from sheet config internally.
|
||||
' Call this after ValidateRow when result.Passed = False.
|
||||
' ============================================================
|
||||
Public Sub OutputError(ws As Worksheet, rowNum As Long, result As ValidationResult)
|
||||
Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
|
||||
Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName)
|
||||
Dim errorCol As Long: errorCol = ColNum(CStr(sheetConf("ErrorCol")))
|
||||
|
||||
If result.Passed Then
|
||||
If Not StartsWith(ws.Cells(rowNum, errorCol).Value, "W") Then
|
||||
ws.Cells(rowNum, errorCol).ClearContents
|
||||
End If
|
||||
Else
|
||||
Dim cellAddr As String: cellAddr = ColLetter(result.ErrorCol)
|
||||
ws.Cells(rowNum, errorCol).Value = GetErrorMsg(result.ErrorCode, cellAddr & CStr(result.ErrorRow), result.Extra)
|
||||
ws.Cells(rowNum, result.ErrorCol).Interior.Color = RGB(255, 0, 0)
|
||||
End If
|
||||
End Sub
|
||||
BIN
通勤手当テンプレート20260528.xlsm
Normal file
BIN
通勤手当テンプレート20260528.xlsm
Normal file
Binary file not shown.
Reference in New Issue
Block a user