通勤認定エクセルツール対応18
This commit is contained in:
guanxiangwei
@@ -344,13 +344,13 @@ Private Sub RefreshSheetDict()
|
|||||||
' C1
|
' C1
|
||||||
Set sheetConf = CreateObject("Scripting.Dictionary")
|
Set sheetConf = CreateObject("Scripting.Dictionary")
|
||||||
sheetConf("StartCol") = "C"
|
sheetConf("StartCol") = "C"
|
||||||
sheetConf("EndCol") = "BC"
|
sheetConf("EndCol") = "BG"
|
||||||
sheetConf("ErrorCol") = "B"
|
sheetConf("ErrorCol") = "B"
|
||||||
sheetConf("StartRow") = 8
|
sheetConf("StartRow") = 8
|
||||||
sheetConf("HeaderRow") = 6
|
sheetConf("HeaderRow") = 6
|
||||||
sheetConf("CSV_Encoding") = "shift_jis"
|
sheetConf("CSV_Encoding") = "shift_jis"
|
||||||
sheetConf("HasHeader") = True
|
sheetConf("HasHeader") = True
|
||||||
sheetConf("ExpectedColumnCount") = 41
|
sheetConf("ExpectedColumnCount") = 45
|
||||||
sheetConf("HeaderColumns") = Array("C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "W", "X", "Y", "Z", "AA", "AE", "AF", "AG", "AH", "AI", "AM", "AN", "AO", "AP", "AQ", "AU", "AV", "AW", "AX", "AY", "AZ", "BA", "BB", "BC", "BD", "BE", "BF", "BG")
|
sheetConf("HeaderColumns") = Array("C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "W", "X", "Y", "Z", "AA", "AE", "AF", "AG", "AH", "AI", "AM", "AN", "AO", "AP", "AQ", "AU", "AV", "AW", "AX", "AY", "AZ", "BA", "BB", "BC", "BD", "BE", "BF", "BG")
|
||||||
sheetConf("AlwaysQuote") = False
|
sheetConf("AlwaysQuote") = False
|
||||||
sheetConf("FilterRow") = 7
|
sheetConf("FilterRow") = 7
|
||||||
|
|||||||
+236
-243
@@ -56,7 +56,7 @@ Private Function KUKAN_START_DAY_COLS() As Variant
|
|||||||
End Function
|
End Function
|
||||||
|
|
||||||
Private Function DATE_COLS() As Variant
|
Private Function DATE_COLS() As Variant
|
||||||
DATE_COLS = Array(4, 5, 6, 26, 34, 42, 50, 56, 59) ' D, E, F, Z, AH, AP, AX, BC, BF
|
DATE_COLS = Array(4, 5, 6, 26, 34, 42, 50, 55, 58) ' D, E, F, Z, AH, AP, AX, BC, BF
|
||||||
End Function
|
End Function
|
||||||
|
|
||||||
Private Function NUMBER_COLS() As Variant
|
Private Function NUMBER_COLS() As Variant
|
||||||
@@ -89,15 +89,7 @@ Private Sub Worksheet_Change(ByVal Target As Range)
|
|||||||
With Me
|
With Me
|
||||||
Set watchArea = Union( _
|
Set watchArea = Union( _
|
||||||
.Columns("C"), _
|
.Columns("C"), _
|
||||||
.Columns("D"), _
|
.Columns("D:BG") _
|
||||||
.Columns("E"), _
|
|
||||||
.Columns("F"), _
|
|
||||||
.Columns("G"), _
|
|
||||||
.Columns("I"), _
|
|
||||||
.Columns("S:X"), _
|
|
||||||
.Columns("AA:AF"), _
|
|
||||||
.Columns("AI:AN"), _
|
|
||||||
.Columns("AQ:AV") _
|
|
||||||
)
|
)
|
||||||
End With
|
End With
|
||||||
Dim intersectRng As Range: Set intersectRng = Application.Intersect(Target, watchArea)
|
Dim intersectRng As Range: Set intersectRng = Application.Intersect(Target, watchArea)
|
||||||
@@ -278,6 +270,240 @@ Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
|
|||||||
End If
|
End If
|
||||||
End Sub
|
End Sub
|
||||||
|
|
||||||
|
|
||||||
|
' Validation logic
|
||||||
|
Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As Long)
|
||||||
|
On Error GoTo ErrHandler
|
||||||
|
|
||||||
|
Dim engine As ValidationRuleEngine: Set engine = New ValidationRuleEngine
|
||||||
|
With engine
|
||||||
|
' Required columns
|
||||||
|
.AddRequired "C"
|
||||||
|
.AddRequired "D"
|
||||||
|
.AddRequired "E"
|
||||||
|
.AddRequired "F"
|
||||||
|
.AddRequired "G"
|
||||||
|
.AddRequired "L"
|
||||||
|
.AddRequired "M"
|
||||||
|
.AddRequired "N"
|
||||||
|
.AddRequired "BA"
|
||||||
|
|
||||||
|
' Date columns
|
||||||
|
.AddDate "D"
|
||||||
|
.AddDate "E"
|
||||||
|
.AddDate "F"
|
||||||
|
.AddDate "Z"
|
||||||
|
.AddDate "AH"
|
||||||
|
.AddDate "AP"
|
||||||
|
.AddDate "AX"
|
||||||
|
.AddDate "BC"
|
||||||
|
.AddDate "BF"
|
||||||
|
|
||||||
|
' Number columns (numeric check only, no digit limit)
|
||||||
|
.AddNumber "L", 2
|
||||||
|
.AddNumber "P", 4, 1
|
||||||
|
.AddNumber "Q", 6
|
||||||
|
.AddNumber "R", 6
|
||||||
|
|
||||||
|
' G column o3Cache
|
||||||
|
.AddCodeSelect "G", CACHE_O3
|
||||||
|
|
||||||
|
' M column oufukuList
|
||||||
|
.AddCodeSelect "M", "oufukuList"
|
||||||
|
|
||||||
|
' N column koutaiList
|
||||||
|
.AddCodeSelect "N", "koutaiList"
|
||||||
|
End With
|
||||||
|
|
||||||
|
Dim result As ValidationResult: Set result = engine.ValidateRow(ws, rowNum, lastDataRow)
|
||||||
|
If result.ErrorCode <> "" Then Exit Sub
|
||||||
|
|
||||||
|
' === Special cases (cross-column / cross-cache) ===
|
||||||
|
Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
|
||||||
|
Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName)
|
||||||
|
Dim errorCol As String: errorCol = sheetConf("ErrorCol")
|
||||||
|
Dim errorCell As Range: Set errorCell = ws.Cells(rowNum, errorCol)
|
||||||
|
|
||||||
|
' I/J address validation
|
||||||
|
Dim o1Cache As Object: Set o1Cache = GetCache(CACHE_O1)
|
||||||
|
Dim ColI As String: ColI = "I"
|
||||||
|
Dim ColJ As String: ColJ = "J"
|
||||||
|
Dim address1 As String: address1 = Trim(ws.Cells(rowNum, ColI).Value)
|
||||||
|
Dim address2 As String: address2 = Trim(ws.Cells(rowNum, ColJ).Value)
|
||||||
|
If address1 = "" Then
|
||||||
|
If address2 <> "" Then
|
||||||
|
errorCell.Value = ColJ & " column is invalid"
|
||||||
|
ws.Range(ColJ & rowNum).Interior.Color = RGB(255, 0, 0)
|
||||||
|
Exit Sub
|
||||||
|
End If
|
||||||
|
Else
|
||||||
|
Dim empNo As String: empNo = Trim(ws.Cells(rowNum, 3).Value)
|
||||||
|
If Not o1Cache.Exists(empNo) Then
|
||||||
|
errorCell.Value = ColI & " column is invalid"
|
||||||
|
ws.Range(ColI & rowNum).Interior.Color = RGB(255, 0, 0)
|
||||||
|
Exit Sub
|
||||||
|
End If
|
||||||
|
Dim innerDict As Object: Set innerDict = o1Cache(empNo)
|
||||||
|
If Not innerDict.Exists(address1) Then
|
||||||
|
errorCell.Value = ColI & " column is invalid"
|
||||||
|
ws.Range(ColI & rowNum).Interior.Color = RGB(255, 0, 0)
|
||||||
|
Exit Sub
|
||||||
|
End If
|
||||||
|
Dim addr2Dict As Object: Set addr2Dict = innerDict(address1)
|
||||||
|
If Not addr2Dict.Exists(address2) Then
|
||||||
|
errorCell.Value = ColJ & " column is invalid"
|
||||||
|
ws.Range(ColJ & rowNum).Interior.Color = RGB(255, 0, 0)
|
||||||
|
Exit Sub
|
||||||
|
End If
|
||||||
|
End If
|
||||||
|
|
||||||
|
' K column (readonly)
|
||||||
|
Dim ColK As String: ColK = "K"
|
||||||
|
If Trim(ws.Cells(rowNum, ColK).Value) <> "" Then
|
||||||
|
errorCell.Value = ColK & " column can not be input"
|
||||||
|
ws.Range(ColK & rowNum).Interior.Color = RGB(255, 0, 0)
|
||||||
|
Exit Sub
|
||||||
|
End If
|
||||||
|
|
||||||
|
' KUKAN block (kept as-is)
|
||||||
|
Dim m1Cache As Object: Set m1Cache = GetCache("M1")
|
||||||
|
Dim m2Cache As Object: Set m2Cache = GetCache("M2")
|
||||||
|
Dim kukanCols As Variant
|
||||||
|
kukanCols = Array(KUKAN_TRANSPORT_COLS, KUKAN_STATION_COLS, KUKAN_ARRIVAL_COLS, KUKAN_TICKET_COLS, KUKAN_CODE2_COLS, KUKAN_START_DAY_COLS)
|
||||||
|
|
||||||
|
Dim kukanIdx As Long
|
||||||
|
For kukanIdx = LBound(KUKAN_CODE_COLS) To UBound(KUKAN_CODE_COLS)
|
||||||
|
Dim kukanCol As Long: kukanCol = KUKAN_CODE_COLS(kukanIdx)
|
||||||
|
Dim kukanCode As String: kukanCode = Trim(ws.Cells(rowNum, kukanCol).Value)
|
||||||
|
Dim kukanLetter As String: kukanLetter = Split(ws.Cells(1, kukanCol).Address, "$")(1)
|
||||||
|
|
||||||
|
If kukanCode <> "" Then
|
||||||
|
If Not m1Cache.Exists(kukanCode) Then
|
||||||
|
errorCell.Value = kukanLetter & " column does not exist"
|
||||||
|
ws.Range(kukanLetter & rowNum).Interior.Color = RGB(255, 0, 0)
|
||||||
|
Exit Sub
|
||||||
|
End If
|
||||||
|
|
||||||
|
Dim ticketCol As Long: ticketCol = KUKAN_TICKET_COLS(kukanIdx)
|
||||||
|
Dim code2Col As Long: code2Col = KUKAN_CODE2_COLS(kukanIdx)
|
||||||
|
Dim teikiCol As Long: teikiCol = KUKAN_TEIKI_COLS(kukanIdx)
|
||||||
|
Dim ticketVal As String: ticketVal = GetCode(Trim(ws.Cells(rowNum, ticketCol).Value))
|
||||||
|
Dim code2Val As String: code2Val = GetCode(Trim(ws.Cells(rowNum, code2Col).Value))
|
||||||
|
Dim ticketLetter As String: ticketLetter = Split(ws.Cells(1, ticketCol).Address, "$")(1)
|
||||||
|
Dim code2Letter As String: code2Letter = Split(ws.Cells(1, code2Col).Address, "$")(1)
|
||||||
|
|
||||||
|
If ticketVal = "" Then
|
||||||
|
errorCell.Value = ticketLetter & " column must be input"
|
||||||
|
ws.Range(ticketLetter & rowNum).Interior.Color = RGB(255, 0, 0)
|
||||||
|
Exit Sub
|
||||||
|
End If
|
||||||
|
|
||||||
|
If ticketVal = "0" Then
|
||||||
|
If code2Val <> "" Then
|
||||||
|
errorCell.Value = code2Letter & " column is invalid"
|
||||||
|
ws.Range(code2Letter & rowNum).Interior.Color = RGB(255, 0, 0)
|
||||||
|
Exit Sub
|
||||||
|
End If
|
||||||
|
Else
|
||||||
|
Dim kanshuDict As Object
|
||||||
|
If m2Cache.Exists(kukanCode) Then
|
||||||
|
Set kanshuDict = m2Cache(kukanCode)
|
||||||
|
If Not kanshuDict.Exists(ticketVal) Then
|
||||||
|
errorCell.Value = ticketLetter & " column is invalid"
|
||||||
|
ws.Range(ticketLetter & rowNum).Interior.Color = RGB(255, 0, 0)
|
||||||
|
Exit Sub
|
||||||
|
End If
|
||||||
|
|
||||||
|
If code2Val = "" Then
|
||||||
|
errorCell.Value = code2Letter & " column should be input"
|
||||||
|
ws.Range(code2Letter & rowNum).Interior.Color = RGB(255, 0, 0)
|
||||||
|
Exit Sub
|
||||||
|
Else
|
||||||
|
Dim codeDict As Object: Set codeDict = kanshuDict(ticketVal)
|
||||||
|
If Not codeDict.Exists(code2Val) Then
|
||||||
|
errorCell.Value = code2Letter & " column is invalid"
|
||||||
|
ws.Range(code2Letter & rowNum).Interior.Color = RGB(255, 0, 0)
|
||||||
|
Exit Sub
|
||||||
|
Else
|
||||||
|
Dim teikiValue As String: teikiValue = Trim(ws.Cells(rowNum, teikiCol).Value)
|
||||||
|
If ticketVal = "1" And teikiValue = "" Then
|
||||||
|
Dim teikiLetter As String: teikiLetter = ColLetter(teikiCol)
|
||||||
|
errorCell.Value = teikiLetter & " column is required"
|
||||||
|
ws.Range(teikiLetter & rowNum).Interior.Color = RGB(255, 0, 0)
|
||||||
|
Exit Sub
|
||||||
|
End If
|
||||||
|
End If
|
||||||
|
End If
|
||||||
|
End If
|
||||||
|
End If
|
||||||
|
Else
|
||||||
|
Dim colGroup As Variant
|
||||||
|
For Each colGroup In kukanCols
|
||||||
|
Dim checkCol As Long: checkCol = colGroup(kukanIdx)
|
||||||
|
Dim checkVal As String: checkVal = Trim(ws.Cells(rowNum, checkCol).Value)
|
||||||
|
If checkVal <> "" Then
|
||||||
|
Dim checkLetter As String: checkLetter = Split(ws.Cells(1, checkCol).Address, "$")(1)
|
||||||
|
errorCell.Value = checkLetter & " column requires " & kukanLetter & " column"
|
||||||
|
ws.Range(checkLetter & rowNum).Interior.Color = RGB(255, 0, 0)
|
||||||
|
Exit Sub
|
||||||
|
End If
|
||||||
|
Next colGroup
|
||||||
|
End If
|
||||||
|
Next kukanIdx
|
||||||
|
|
||||||
|
' KUKAN_CODE_COLS duplicate check
|
||||||
|
Dim kukanCodes As Object: Set kukanCodes = CreateObject("Scripting.Dictionary")
|
||||||
|
For kukanIdx = LBound(KUKAN_CODE_COLS) To UBound(KUKAN_CODE_COLS)
|
||||||
|
kukanCol = KUKAN_CODE_COLS(kukanIdx)
|
||||||
|
kukanCode = Trim(ws.Cells(rowNum, kukanCol).Value)
|
||||||
|
If kukanCode <> "" Then
|
||||||
|
If kukanCodes.Exists(kukanCode) Then
|
||||||
|
kukanLetter = Split(ws.Cells(1, kukanCol).Address, "$")(1)
|
||||||
|
errorCell.Value = GetErrorMsg("E003", kukanLetter & rowNum)
|
||||||
|
ws.Range(kukanLetter & rowNum).Interior.Color = RGB(255, 0, 0)
|
||||||
|
Exit Sub
|
||||||
|
Else
|
||||||
|
kukanCodes.Add kukanCode, True
|
||||||
|
End If
|
||||||
|
End If
|
||||||
|
Next kukanIdx
|
||||||
|
|
||||||
|
' H/BB/BC (always runs, independent of special cases)
|
||||||
|
Dim linkCellValue As String: linkCellValue = ws.Cells(3, "H").Value
|
||||||
|
Dim ColBF As String: ColBF = "BF"
|
||||||
|
Dim ColBG As String: ColBG = "BG"
|
||||||
|
Dim valBF As String: valBF = Trim(ws.Cells(rowNum, ColBF).Value)
|
||||||
|
Dim valBG As String: valBG = Trim(ws.Cells(rowNum, ColBG).Value)
|
||||||
|
If linkCellValue = "1" Then
|
||||||
|
If valBF <> "" Then
|
||||||
|
errorCell.Value = GetErrorMsg("E005", ColBF & rowNum)
|
||||||
|
ws.Range(ColBF & rowNum).Interior.Color = RGB(255, 0, 0)
|
||||||
|
Exit Sub
|
||||||
|
End If
|
||||||
|
If valBG <> "" Then
|
||||||
|
errorCell.Value = GetErrorMsg("E005", ColBG & rowNum)
|
||||||
|
ws.Range(ColBG & rowNum).Interior.Color = RGB(255, 0, 0)
|
||||||
|
Exit Sub
|
||||||
|
End If
|
||||||
|
ElseIf linkCellValue = "2" Then
|
||||||
|
If valBF = "" Then
|
||||||
|
errorCell.Value = GetErrorMsg("E002", ColBF & rowNum)
|
||||||
|
ws.Range(ColBF & rowNum).Interior.Color = RGB(255, 0, 0)
|
||||||
|
Exit Sub
|
||||||
|
End If
|
||||||
|
If valBG = "" Then
|
||||||
|
errorCell.Value = GetErrorMsg("E002", ColBG & rowNum)
|
||||||
|
ws.Range(ColBG & rowNum).Interior.Color = RGB(255, 0, 0)
|
||||||
|
Exit Sub
|
||||||
|
End If
|
||||||
|
End If
|
||||||
|
|
||||||
|
Exit Sub
|
||||||
|
|
||||||
|
ErrHandler:
|
||||||
|
SetLastErrorMsg Err.Description
|
||||||
|
End Sub
|
||||||
|
|
||||||
Private Sub Refresh(ws As Worksheet, ByVal startRow As Long, ByVal lastDataRow As Long)
|
Private Sub Refresh(ws As Worksheet, ByVal startRow As Long, ByVal lastDataRow As Long)
|
||||||
Dim z1Cache As Object: Set z1Cache = GetCache(CACHE_Z1)
|
Dim z1Cache As Object: Set z1Cache = GetCache(CACHE_Z1)
|
||||||
|
|
||||||
@@ -772,239 +998,6 @@ Private Sub ClearRowData(ByVal rowNum As Long)
|
|||||||
Me.Range(Me.Cells(rowNum, startCol), Me.Cells(rowNum, endCol)).Interior.Color = vbWhite
|
Me.Range(Me.Cells(rowNum, startCol), Me.Cells(rowNum, endCol)).Interior.Color = vbWhite
|
||||||
End Sub
|
End Sub
|
||||||
|
|
||||||
' Validation logic
|
|
||||||
Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As Long)
|
|
||||||
On Error GoTo ErrHandler
|
|
||||||
|
|
||||||
Dim engine As ValidationRuleEngine: Set engine = New ValidationRuleEngine
|
|
||||||
With engine
|
|
||||||
' Required columns
|
|
||||||
.AddRequired "C"
|
|
||||||
.AddRequired "D"
|
|
||||||
.AddRequired "E"
|
|
||||||
.AddRequired "F"
|
|
||||||
.AddRequired "G"
|
|
||||||
.AddRequired "L"
|
|
||||||
.AddRequired "M"
|
|
||||||
.AddRequired "N"
|
|
||||||
.AddRequired "BA"
|
|
||||||
|
|
||||||
' Date columns
|
|
||||||
.AddDate "D"
|
|
||||||
.AddDate "E"
|
|
||||||
.AddDate "F"
|
|
||||||
.AddDate "Z"
|
|
||||||
.AddDate "AH"
|
|
||||||
.AddDate "AP"
|
|
||||||
.AddDate "AX"
|
|
||||||
.AddDate "BC"
|
|
||||||
.AddDate "BF"
|
|
||||||
|
|
||||||
' Number columns (numeric check only, no digit limit)
|
|
||||||
.AddNumber "L", 2
|
|
||||||
.AddNumber "P", 4, 1
|
|
||||||
.AddNumber "Q", 6
|
|
||||||
.AddNumber "R", 6
|
|
||||||
|
|
||||||
' G column o3Cache
|
|
||||||
.AddCodeSelect "G", CACHE_O3
|
|
||||||
|
|
||||||
' M column oufukuList
|
|
||||||
.AddCodeSelect "M", "oufukuList"
|
|
||||||
|
|
||||||
' N column koutaiList
|
|
||||||
.AddCodeSelect "N", "koutaiList"
|
|
||||||
End With
|
|
||||||
|
|
||||||
Dim result As ValidationResult: Set result = engine.ValidateRow(ws, rowNum, lastDataRow)
|
|
||||||
If result.ErrorCode <> "" Then Exit Sub
|
|
||||||
|
|
||||||
' === Special cases (cross-column / cross-cache) ===
|
|
||||||
Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
|
|
||||||
Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName)
|
|
||||||
Dim errorCol As String: errorCol = sheetConf("ErrorCol")
|
|
||||||
Dim errorCell As Range: Set errorCell = ws.Cells(rowNum, errorCol)
|
|
||||||
|
|
||||||
' I/J address validation
|
|
||||||
Dim o1Cache As Object: Set o1Cache = GetCache(CACHE_O1)
|
|
||||||
Dim ColI As String: ColI = "I"
|
|
||||||
Dim ColJ As String: ColJ = "J"
|
|
||||||
Dim address1 As String: address1 = Trim(ws.Cells(rowNum, ColI).Value)
|
|
||||||
Dim address2 As String: address2 = Trim(ws.Cells(rowNum, ColJ).Value)
|
|
||||||
If address1 = "" Then
|
|
||||||
If address2 <> "" Then
|
|
||||||
errorCell.Value = ColJ & " column is invalid"
|
|
||||||
ws.Range(ColJ & rowNum).Interior.Color = RGB(255, 0, 0)
|
|
||||||
Exit Sub
|
|
||||||
End If
|
|
||||||
Else
|
|
||||||
Dim empNo As String: empNo = Trim(ws.Cells(rowNum, 3).Value)
|
|
||||||
If Not o1Cache.Exists(empNo) Then
|
|
||||||
errorCell.Value = ColI & " column is invalid"
|
|
||||||
ws.Range(ColI & rowNum).Interior.Color = RGB(255, 0, 0)
|
|
||||||
Exit Sub
|
|
||||||
End If
|
|
||||||
Dim innerDict As Object: Set innerDict = o1Cache(empNo)
|
|
||||||
If Not innerDict.Exists(address1) Then
|
|
||||||
errorCell.Value = ColI & " column is invalid"
|
|
||||||
ws.Range(ColI & rowNum).Interior.Color = RGB(255, 0, 0)
|
|
||||||
Exit Sub
|
|
||||||
End If
|
|
||||||
Dim addr2Dict As Object: Set addr2Dict = innerDict(address1)
|
|
||||||
If Not addr2Dict.Exists(address2) Then
|
|
||||||
errorCell.Value = ColJ & " column is invalid"
|
|
||||||
ws.Range(ColJ & rowNum).Interior.Color = RGB(255, 0, 0)
|
|
||||||
Exit Sub
|
|
||||||
End If
|
|
||||||
End If
|
|
||||||
|
|
||||||
' K column (readonly)
|
|
||||||
Dim ColK As String: ColK = "K"
|
|
||||||
If Trim(ws.Cells(rowNum, ColK).Value) <> "" Then
|
|
||||||
errorCell.Value = ColK & " column can not be input"
|
|
||||||
ws.Range(ColK & rowNum).Interior.Color = RGB(255, 0, 0)
|
|
||||||
Exit Sub
|
|
||||||
End If
|
|
||||||
|
|
||||||
' KUKAN block (kept as-is)
|
|
||||||
Dim m1Cache As Object: Set m1Cache = GetCache("M1")
|
|
||||||
Dim m2Cache As Object: Set m2Cache = GetCache("M2")
|
|
||||||
Dim kukanCols As Variant
|
|
||||||
kukanCols = Array(KUKAN_TRANSPORT_COLS, KUKAN_STATION_COLS, KUKAN_ARRIVAL_COLS, KUKAN_TICKET_COLS, KUKAN_CODE2_COLS, KUKAN_START_DAY_COLS)
|
|
||||||
|
|
||||||
Dim kukanIdx As Long
|
|
||||||
For kukanIdx = LBound(KUKAN_CODE_COLS) To UBound(KUKAN_CODE_COLS)
|
|
||||||
Dim kukanCol As Long: kukanCol = KUKAN_CODE_COLS(kukanIdx)
|
|
||||||
Dim kukanCode As String: kukanCode = Trim(ws.Cells(rowNum, kukanCol).Value)
|
|
||||||
Dim kukanLetter As String: kukanLetter = Split(ws.Cells(1, kukanCol).Address, "$")(1)
|
|
||||||
|
|
||||||
If kukanCode <> "" Then
|
|
||||||
If Not m1Cache.Exists(kukanCode) Then
|
|
||||||
errorCell.Value = kukanLetter & " column does not exist"
|
|
||||||
ws.Range(kukanLetter & rowNum).Interior.Color = RGB(255, 0, 0)
|
|
||||||
Exit Sub
|
|
||||||
End If
|
|
||||||
|
|
||||||
Dim ticketCol As Long: ticketCol = KUKAN_TICKET_COLS(kukanIdx)
|
|
||||||
Dim code2Col As Long: code2Col = KUKAN_CODE2_COLS(kukanIdx)
|
|
||||||
Dim teikiCol As Long: teikiCol = KUKAN_TEIKI_COLS(kukanIdx)
|
|
||||||
Dim ticketVal As String: ticketVal = GetCode(Trim(ws.Cells(rowNum, ticketCol).Value))
|
|
||||||
Dim code2Val As String: code2Val = GetCode(Trim(ws.Cells(rowNum, code2Col).Value))
|
|
||||||
Dim ticketLetter As String: ticketLetter = Split(ws.Cells(1, ticketCol).Address, "$")(1)
|
|
||||||
Dim code2Letter As String: code2Letter = Split(ws.Cells(1, code2Col).Address, "$")(1)
|
|
||||||
|
|
||||||
If ticketVal = "" Then
|
|
||||||
errorCell.Value = ticketLetter & " column must be input"
|
|
||||||
ws.Range(ticketLetter & rowNum).Interior.Color = RGB(255, 0, 0)
|
|
||||||
Exit Sub
|
|
||||||
End If
|
|
||||||
|
|
||||||
If ticketVal = "0" Then
|
|
||||||
If code2Val <> "" Then
|
|
||||||
errorCell.Value = code2Letter & " column is invalid"
|
|
||||||
ws.Range(code2Letter & rowNum).Interior.Color = RGB(255, 0, 0)
|
|
||||||
Exit Sub
|
|
||||||
End If
|
|
||||||
Else
|
|
||||||
Dim kanshuDict As Object
|
|
||||||
If m2Cache.Exists(kukanCode) Then
|
|
||||||
Set kanshuDict = m2Cache(kukanCode)
|
|
||||||
If Not kanshuDict.Exists(ticketVal) Then
|
|
||||||
errorCell.Value = ticketLetter & " column is invalid"
|
|
||||||
ws.Range(ticketLetter & rowNum).Interior.Color = RGB(255, 0, 0)
|
|
||||||
Exit Sub
|
|
||||||
End If
|
|
||||||
|
|
||||||
If code2Val = "" Then
|
|
||||||
errorCell.Value = code2Letter & " column should be input"
|
|
||||||
ws.Range(code2Letter & rowNum).Interior.Color = RGB(255, 0, 0)
|
|
||||||
Exit Sub
|
|
||||||
Else
|
|
||||||
Dim codeDict As Object: Set codeDict = kanshuDict(ticketVal)
|
|
||||||
If Not codeDict.Exists(code2Val) Then
|
|
||||||
errorCell.Value = code2Letter & " column is invalid"
|
|
||||||
ws.Range(code2Letter & rowNum).Interior.Color = RGB(255, 0, 0)
|
|
||||||
Exit Sub
|
|
||||||
Else
|
|
||||||
Dim teikiValue As String: teikiValue = Trim(ws.Cells(rowNum, teikiCol).Value)
|
|
||||||
If ticketVal = "1" And teikiValue = "" Then
|
|
||||||
Dim teikiLetter As String: teikiLetter = ColLetter(teikiCol)
|
|
||||||
errorCell.Value = teikiLetter & " column is required"
|
|
||||||
ws.Range(teikiLetter & rowNum).Interior.Color = RGB(255, 0, 0)
|
|
||||||
Exit Sub
|
|
||||||
End If
|
|
||||||
End If
|
|
||||||
End If
|
|
||||||
End If
|
|
||||||
End If
|
|
||||||
Else
|
|
||||||
Dim colGroup As Variant
|
|
||||||
For Each colGroup In kukanCols
|
|
||||||
Dim checkCol As Long: checkCol = colGroup(kukanIdx)
|
|
||||||
Dim checkVal As String: checkVal = Trim(ws.Cells(rowNum, checkCol).Value)
|
|
||||||
If checkVal <> "" Then
|
|
||||||
Dim checkLetter As String: checkLetter = Split(ws.Cells(1, checkCol).Address, "$")(1)
|
|
||||||
errorCell.Value = checkLetter & " column requires " & kukanLetter & " column"
|
|
||||||
ws.Range(checkLetter & rowNum).Interior.Color = RGB(255, 0, 0)
|
|
||||||
Exit Sub
|
|
||||||
End If
|
|
||||||
Next colGroup
|
|
||||||
End If
|
|
||||||
Next kukanIdx
|
|
||||||
|
|
||||||
' KUKAN_CODE_COLS duplicate check
|
|
||||||
Dim kukanCodes As Object: Set kukanCodes = CreateObject("Scripting.Dictionary")
|
|
||||||
For kukanIdx = LBound(KUKAN_CODE_COLS) To UBound(KUKAN_CODE_COLS)
|
|
||||||
kukanCol = KUKAN_CODE_COLS(kukanIdx)
|
|
||||||
kukanCode = Trim(ws.Cells(rowNum, kukanCol).Value)
|
|
||||||
If kukanCode <> "" Then
|
|
||||||
If kukanCodes.Exists(kukanCode) Then
|
|
||||||
kukanLetter = Split(ws.Cells(1, kukanCol).Address, "$")(1)
|
|
||||||
errorCell.Value = GetErrorMsg("E003", kukanLetter & rowNum)
|
|
||||||
ws.Range(kukanLetter & rowNum).Interior.Color = RGB(255, 0, 0)
|
|
||||||
Exit Sub
|
|
||||||
Else
|
|
||||||
kukanCodes.Add kukanCode, True
|
|
||||||
End If
|
|
||||||
End If
|
|
||||||
Next kukanIdx
|
|
||||||
|
|
||||||
' H/BB/BC (always runs, independent of special cases)
|
|
||||||
Dim linkCellValue As String: linkCellValue = ws.Cells(3, "H").Value
|
|
||||||
Dim ColBF As String: ColBF = "BF"
|
|
||||||
Dim ColBG As String: ColBG = "BG"
|
|
||||||
Dim valBF As String: valBF = Trim(ws.Cells(rowNum, ColBF).Value)
|
|
||||||
Dim valBG As String: valBG = Trim(ws.Cells(rowNum, ColBG).Value)
|
|
||||||
If linkCellValue = "1" Then
|
|
||||||
If valBF <> "" Then
|
|
||||||
errorCell.Value = GetErrorMsg("E005", ColBF & rowNum)
|
|
||||||
ws.Range(ColBF & rowNum).Interior.Color = RGB(255, 0, 0)
|
|
||||||
Exit Sub
|
|
||||||
End If
|
|
||||||
If valBG <> "" Then
|
|
||||||
errorCell.Value = GetErrorMsg("E005", ColBG & rowNum)
|
|
||||||
ws.Range(ColBG & rowNum).Interior.Color = RGB(255, 0, 0)
|
|
||||||
Exit Sub
|
|
||||||
End If
|
|
||||||
ElseIf linkCellValue = "2" Then
|
|
||||||
If valBF = "" Then
|
|
||||||
errorCell.Value = GetErrorMsg("E002", ColBF & rowNum)
|
|
||||||
ws.Range(ColBF & rowNum).Interior.Color = RGB(255, 0, 0)
|
|
||||||
Exit Sub
|
|
||||||
End If
|
|
||||||
If valBG = "" Then
|
|
||||||
errorCell.Value = GetErrorMsg("E002", ColBG & rowNum)
|
|
||||||
ws.Range(ColBG & rowNum).Interior.Color = RGB(255, 0, 0)
|
|
||||||
Exit Sub
|
|
||||||
End If
|
|
||||||
End If
|
|
||||||
|
|
||||||
Exit Sub
|
|
||||||
|
|
||||||
ErrHandler:
|
|
||||||
SetLastErrorMsg Err.Description
|
|
||||||
End Sub
|
|
||||||
|
|
||||||
' Create teiki dropdown based on M2 cache
|
' Create teiki dropdown based on M2 cache
|
||||||
Private Sub CreateTeikiDropdown(ByVal row As Long, ByVal idx As Long)
|
Private Sub CreateTeikiDropdown(ByVal row As Long, ByVal idx As Long)
|
||||||
' Get kukanCode from KUKAN_CODE_COLS
|
' Get kukanCode from KUKAN_CODE_COLS
|
||||||
|
|||||||
@@ -43,6 +43,12 @@ Public Function ValidateRow(ws As Worksheet, rowNum As Long, Optional lastDataRo
|
|||||||
If dateVal <> "" Then
|
If dateVal <> "" Then
|
||||||
If Len(dateVal) <> 10 Or Mid(dateVal, 5, 1) <> "-" Or Mid(dateVal, 8, 1) <> "-" Then
|
If Len(dateVal) <> 10 Or Mid(dateVal, 5, 1) <> "-" Or Mid(dateVal, 8, 1) <> "-" Then
|
||||||
result.SetFail ERR_INVALID, ColIndex, rowNum
|
result.SetFail ERR_INVALID, ColIndex, rowNum
|
||||||
|
ElseIf Not IsNumeric(Left(dateVal, 4)) Then
|
||||||
|
result.SetFail ERR_INVALID, ColIndex, rowNum
|
||||||
|
ElseIf Not IsNumeric(Mid(dateVal, 6, 2)) Then
|
||||||
|
result.SetFail ERR_INVALID, ColIndex, rowNum
|
||||||
|
ElseIf Not IsNumeric(Right(dateVal, 2)) Then
|
||||||
|
result.SetFail ERR_INVALID, ColIndex, rowNum
|
||||||
End If
|
End If
|
||||||
End If
|
End If
|
||||||
|
|
||||||
|
|||||||
Binary file not shown.
Reference in New Issue
Block a user