1092 lines
42 KiB
OpenEdge ABL
1092 lines
42 KiB
OpenEdge ABL
' ============================================================
|
|
' Module Name: Tukin_C1
|
|
' Module Desc: Commuter allowance editing sheet (no CSV import)
|
|
' Module Methods:
|
|
' - Tukin_ValidateRow
|
|
' - FillTransportFromM1KukanD
|
|
' - FillDepartureFromM1KukanD
|
|
' - FillArrivalFromM1KukanD
|
|
' - FillKukanFromM1
|
|
' - FillKanshuFromM2
|
|
' - FillCodeFromM2
|
|
' - BuildAddress1Dropdown
|
|
' - FillZ1Dropdown
|
|
' ============================================================
|
|
' ====== (Tukin_C1) =======
|
|
' Commuter allowance editing sheet
|
|
' No CSV import - direct editing only
|
|
' ============================================================
|
|
' Column arrays for 4 kukan sections
|
|
' ============================================================
|
|
Const CSHAINNO_COL As String = "C"
|
|
Const ADDRESS1_COL As String = "I"
|
|
Const ADDRESS2_COL As String = "J"
|
|
Const MMONTH_AMOUNT_KBN_COL As String = "BB"
|
|
|
|
Private Function KUKAN_CODE_COLS() As Variant
|
|
KUKAN_CODE_COLS = Array(19, 27, 35, 43) ' S, AA, AI, AQ
|
|
End Function
|
|
|
|
Private Function KUKAN_TRANSPORT_COLS() As Variant
|
|
KUKAN_TRANSPORT_COLS = Array(20, 28, 36, 44) ' T, AB, AJ, AR
|
|
End Function
|
|
|
|
Private Function KUKAN_STATION_COLS() As Variant
|
|
KUKAN_STATION_COLS = Array(21, 29, 37, 45) ' U, AC, AK, AS
|
|
End Function
|
|
|
|
Private Function KUKAN_ARRIVAL_COLS() As Variant
|
|
KUKAN_ARRIVAL_COLS = Array(22, 30, 38, 46) ' V, AD, AL, AT
|
|
End Function
|
|
|
|
Private Function KUKAN_TICKET_COLS() As Variant
|
|
KUKAN_TICKET_COLS = Array(23, 31, 39, 47) ' W, AE, AM, AU
|
|
End Function
|
|
|
|
Private Function KUKAN_CODE2_COLS() As Variant
|
|
KUKAN_CODE2_COLS = Array(24, 32, 40, 48) ' X, AF, AN, AV
|
|
End Function
|
|
|
|
Private Function KUKAN_TEIKI_COLS() As Variant
|
|
KUKAN_TEIKI_COLS = Array(25, 33, 41, 49) ' Y, AG, AO, AW
|
|
End Function
|
|
|
|
Private Function KUKAN_START_DAY_COLS() As Variant
|
|
KUKAN_START_DAY_COLS = Array(26, 34, 42, 50) ' Z, AH, AP, AX
|
|
End Function
|
|
|
|
Private Function DATE_COLS() As Variant
|
|
DATE_COLS = Array(4, 5, 6, 26, 34, 42, 50, 56, 59) ' D, E, F, Z, AH, AP, AX, BC, BF
|
|
End Function
|
|
|
|
Private Function NUMBER_COLS() As Variant
|
|
NUMBER_COLS = Array("L", "P", "Q", "R")
|
|
End Function
|
|
|
|
' ============================================================
|
|
' Helper: Get index by value, return -1 if not found
|
|
' ============================================================
|
|
Private Function GetIdx(val As Long, arr As Variant) As Long
|
|
Dim i As Long
|
|
For i = LBound(arr) To UBound(arr)
|
|
If arr(i) = val Then
|
|
GetIdx = i
|
|
Exit Function
|
|
End If
|
|
Next i
|
|
GetIdx = -1
|
|
End Function
|
|
|
|
' ============================================================
|
|
' Event Handlers
|
|
' ============================================================
|
|
Private Sub Worksheet_Change(ByVal Target As Range)
|
|
|
|
Dim HasHeaderEdit As Boolean: HasHeaderEdit = CheckHeaderEdit(Me, Target)
|
|
If HasHeaderEdit = True Then Exit Sub
|
|
|
|
Dim watchArea As Range
|
|
With Me
|
|
Set watchArea = Union( _
|
|
.Columns("C"), _
|
|
.Columns("D"), _
|
|
.Columns("E"), _
|
|
.Columns("F"), _
|
|
.Columns("G"), _
|
|
.Columns("I"), _
|
|
.Columns("S:X"), _
|
|
.Columns("AA:AF"), _
|
|
.Columns("AI:AN"), _
|
|
.Columns("AQ:AV") _
|
|
)
|
|
End With
|
|
Dim intersectRng As Range: Set intersectRng = Application.Intersect(Target, watchArea)
|
|
If intersectRng Is Nothing Then Exit Sub
|
|
|
|
If Target.Row < 8 Then Exit Sub
|
|
Dim idx As Long
|
|
|
|
' Check if cache is loaded
|
|
Application.EnableEvents = False
|
|
On Error GoTo Finally
|
|
Dim testCache As Object: Set testCache = GetCache("Z1")
|
|
|
|
' === Column C changes ===
|
|
If Target.Column = 3 Then
|
|
Dim cell As Range
|
|
For Each cell In Target
|
|
Dim cshainno As String: cshainno = Trim(cell.Value)
|
|
If cshainno = "" Then
|
|
Call ClearRowData(cell.Row)
|
|
Else
|
|
' rebuild dropdown list
|
|
Call BuildAddress1Dropdown(cell.Row, cshainno)
|
|
Call ReFillAddress1(cell.Row, cshainno)
|
|
Call BuildAddress2Dropdown(cell.Row, cshainno)
|
|
Call ReFillAddress2(cell.Row, cshainno)
|
|
Call RebuildDropdowns(cell.Row)
|
|
End If
|
|
Next
|
|
End If
|
|
|
|
' auto fill G column [todoke biko]
|
|
If Target.Column = 7 Then
|
|
Dim cellG As Range
|
|
For Each cellG In Target
|
|
Dim todoke As String: todoke = Trim(cellG.Value)
|
|
If todoke <> "" Then
|
|
Dim z4Cache As Object: Set z4Cache = GetCache("Z4")
|
|
Dim todokeCde As String: todokeCde = GetCode(todoke)
|
|
If z4Cache.Exists(todokeCde) Then
|
|
Dim cellH As Range: Set cellH = Me.Cells(cellG.Row, 8)
|
|
cellH.Value = z4Cache(todokeCde)(0)
|
|
End If
|
|
End If
|
|
Next
|
|
End If
|
|
|
|
' === Column I changes ===
|
|
If Target.Column = 9 Then
|
|
Dim cellI As Range
|
|
For Each cellI In Target
|
|
Call BuildAddress2Dropdown(cellI.Row, Trim(Me.Cells(cellI.Row, CSHAINNO_COL).Value))
|
|
Next
|
|
End If
|
|
|
|
' === Date columns changes ===
|
|
idx = GetIdx(Target.Column, DATE_COLS)
|
|
If idx >= 0 Then
|
|
Dim cellDate As Range
|
|
For Each cellDate In Target
|
|
If Trim(cellDate.Value) <> "" Then
|
|
Dim formattedDate As String: formattedDate = FormatDateInput(cellDate.Value)
|
|
cellDate.Value = FormatDateInput(formattedDate)
|
|
If cellDate.Column = 5 Then
|
|
Dim fCell As Range: Set fCell = Me.Cells(cellDate.Row, 6)
|
|
If Trim(fCell.Value) = "" Then
|
|
fCell.Value = formattedDate
|
|
End If
|
|
End If
|
|
End If
|
|
Next
|
|
End If
|
|
|
|
' === Transport column changes (T, AB, AJ, AR) ===
|
|
idx = GetIdx(Target.Column, KUKAN_TRANSPORT_COLS)
|
|
If idx >= 0 Then
|
|
Dim cellT As Range
|
|
For Each cellT In Target
|
|
Me.Cells(cellT.Row, KUKAN_STATION_COLS(idx)).ClearContents
|
|
Me.Cells(cellT.Row, KUKAN_ARRIVAL_COLS(idx)).ClearContents
|
|
If Trim(cellT.Value) <> "" Then
|
|
Call CreateFromStationDropdown(cellT.Row, KUKAN_TRANSPORT_COLS(idx), KUKAN_STATION_COLS(idx))
|
|
End If
|
|
Next
|
|
End If
|
|
|
|
' === Station column changes (U, AC, AK, AS) ===
|
|
idx = GetIdx(Target.Column, KUKAN_STATION_COLS)
|
|
If idx >= 0 Then
|
|
Dim cellU As Range
|
|
For Each cellU In Target
|
|
' Clear arrival value first
|
|
Me.Cells(cellU.Row, KUKAN_ARRIVAL_COLS(idx)).ClearContents
|
|
If Trim(cellU.Value) <> "" Then
|
|
Call CreateToStationDropdown(cellU.Row, KUKAN_TRANSPORT_COLS(idx), KUKAN_STATION_COLS(idx), KUKAN_ARRIVAL_COLS(idx))
|
|
End If
|
|
Next
|
|
End If
|
|
|
|
' === Arrival column changes (V, AD, AL, AT) ===
|
|
idx = GetIdx(Target.Column, KUKAN_ARRIVAL_COLS)
|
|
If idx >= 0 Then
|
|
Dim cellV As Range
|
|
For Each cellV In Target
|
|
If Trim(cellV.Value) <> "" Then
|
|
' Reverse lookup: find kukan code by transport + from + to
|
|
Dim foundCode As String
|
|
foundCode = FindKukanCodeByStation(cellV.Row, KUKAN_TRANSPORT_COLS(idx), KUKAN_STATION_COLS(idx), KUKAN_ARRIVAL_COLS(idx))
|
|
If foundCode <> "" Then
|
|
Me.Cells(cellV.Row, KUKAN_CODE_COLS(idx)).Value = foundCode
|
|
Call CreateKenshuDropdown(cellV.Row, idx, foundCode)
|
|
End If
|
|
End If
|
|
Next
|
|
End If
|
|
|
|
' === Kukan code column changes (S, AA, AI, AQ) ===
|
|
idx = GetIdx(Target.Column, KUKAN_CODE_COLS)
|
|
If idx >= 0 Then
|
|
Dim cellK As Range
|
|
For Each cellK In Target
|
|
Call FillKukanFromM1(cellK.Row, idx)
|
|
Next
|
|
End If
|
|
|
|
' === Ticket column changes (W, AE, AM, AU) ===
|
|
idx = GetIdx(Target.Column, KUKAN_TICKET_COLS)
|
|
If idx >= 0 Then
|
|
Dim cellTi As Range
|
|
For Each cellTi In Target
|
|
' Clear old code first
|
|
Dim code2Col As Long: code2Col = KUKAN_CODE2_COLS(idx)
|
|
Me.Cells(cellTi.Row, code2Col).ClearContents
|
|
Me.Cells(cellTi.Row, code2Col).Validation.Delete
|
|
' Also clear teiki column
|
|
Dim teikiCol As Long: teikiCol = KUKAN_TEIKI_COLS(idx)
|
|
Me.Cells(cellTi.Row, teikiCol).ClearContents
|
|
Me.Cells(cellTi.Row, teikiCol).Validation.Delete
|
|
Call BuildM2CodeDropdown(cellTi.Row, KUKAN_CODE_COLS(idx), KUKAN_TICKET_COLS(idx), code2Col)
|
|
Next
|
|
End If
|
|
|
|
' === Code2 column changes (X, AF, AN, AV) ===
|
|
idx = GetIdx(Target.Column, KUKAN_CODE2_COLS)
|
|
If idx >= 0 Then
|
|
Dim cellCode2 As Range
|
|
For Each cellCode2 In Target
|
|
If Trim(cellCode2.Value) <> "" Then
|
|
Call CreateTeikiDropdown(cellCode2.Row, idx)
|
|
End If
|
|
Next
|
|
End If
|
|
|
|
Application.EnableEvents = True
|
|
Exit Sub
|
|
|
|
Finally:
|
|
HandleError "Worksheet_Change"
|
|
Application.EnableEvents = True '
|
|
End Sub
|
|
|
|
' Prevent insert/delete row in header area
|
|
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
|
|
Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
|
|
Dim sheetConf As Object: Set sheetConf = sheetConfDict(Me.CodeName)
|
|
Dim filterRow As Long: filterRow = sheetConf("FilterRow")
|
|
|
|
If Target.Row < filterRow + 1 Then
|
|
Cancel = True
|
|
MsgBox "Cannot insert or delete row in header area.", vbExclamation
|
|
End If
|
|
End Sub
|
|
|
|
Private Sub Refresh(ws As Worksheet, ByVal startRow As Long, ByVal lastDataRow As Long)
|
|
Dim z1Cache As Object: Set z1Cache = GetCache("Z1")
|
|
|
|
Application.EnableEvents = False
|
|
On Error GoTo ErrorHandler
|
|
|
|
Dim r As Long
|
|
For r = startRow To lastDataRow
|
|
Dim cshainno As String: cshainno = Trim(Me.Cells(r, CSHAINNO_COL).Value)
|
|
Call BuildAddress1Dropdown(r, cshainno)
|
|
Call ReFillAddress1(r, cshainno)
|
|
Call BuildAddress2Dropdown(r, cshainno)
|
|
Call ReFillAddress2(r, cshainno)
|
|
Call RebuildDropdowns(r)
|
|
|
|
Call ReFillFromDropdowns(r)
|
|
|
|
' Refresh teiki dropdowns for all 4 sections
|
|
Dim idx As Long
|
|
For idx = 0 To 3
|
|
Dim kukanCode As String: kukanCode = Trim(Me.Cells(r, KUKAN_CODE_COLS(idx)).Value)
|
|
Dim kenshu As String: kenshu = GetCode(Trim(Me.Cells(r, KUKAN_TICKET_COLS(idx)).Value))
|
|
Dim code As String: code = GetCode(Trim(Me.Cells(r, KUKAN_CODE2_COLS(idx)).Value))
|
|
Call BuildM2CodeDropdown(r, KUKAN_CODE_COLS(idx), KUKAN_TICKET_COLS(idx), KUKAN_CODE2_COLS(idx))
|
|
Call ReFillM2CodeDropdown(r, KUKAN_CODE_COLS(idx), KUKAN_TICKET_COLS(idx), KUKAN_CODE2_COLS(idx))
|
|
If kukanCode <> "" And kenshu <> "" And code <> "" Then
|
|
Dim teikiColIndex As Long: teikiColIndex = KUKAN_TEIKI_COLS(idx)
|
|
Call BuildTeikiDropdown(r, kukanCode, kenshu, code, ColLetter(teikiColIndex))
|
|
End If
|
|
Next idx
|
|
Next r
|
|
|
|
Application.EnableEvents = True
|
|
Exit Sub
|
|
|
|
ErrorHandler:
|
|
Application.EnableEvents = True
|
|
Err.Raise ERR_CACHE_NOT_FOUND, "M1.Refresh", "Failed to refresh M1: " & Err.Description
|
|
End Sub
|
|
|
|
Private Sub RebuildDropdowns(ByVal rowNum As Long)
|
|
Dim dropdowns As Variant
|
|
dropdowns = Array( _
|
|
Array("T", "BuildTransportList"), _
|
|
Array("AB", "BuildTransportList"), _
|
|
Array("AJ", "BuildTransportList"), _
|
|
Array("AR", "BuildTransportList"), _
|
|
Array("G", "BuildTodokeList"), _
|
|
Array("M", "BuildOufukuList"), _
|
|
Array("N", "BuildKoutaiList"), _
|
|
Array("AY", "BuildKetteiList"), _
|
|
Array("BA", "BuildHigaitouList"), _
|
|
Array("BG", "BuildKanshokuList") _
|
|
)
|
|
|
|
Dim i As Long
|
|
For i = LBound(dropdowns) To UBound(dropdowns)
|
|
With Me.Cells(rowNum, dropdowns(i)(0)).Validation
|
|
.Delete
|
|
.Add Type:=xlValidateList, Formula1:=Application.Run(dropdowns(i)(1))
|
|
.IgnoreBlank = True
|
|
.InCellDropdown = True
|
|
End With
|
|
Next i
|
|
|
|
Call BuildDropdownFromCacheNamedRange(Me, MMONTH_AMOUNT_KBN_COL, rowNum, "Z3")
|
|
|
|
End Sub
|
|
|
|
Private Sub ReFillFromDropdowns(ByVal rowNum As Long)
|
|
|
|
Dim z3Cache As Object: Set z3Cache = GetCache("Z3")
|
|
Dim valueStrMonthAmountKbn As String: valueStrMonthAmountKbn = Trim(Me.Cells(rowNum, MMONTH_AMOUNT_KBN_COL).Value)
|
|
Dim monthAmountKbn As String: monthAmountKbn = GetCode(valueStrMonthAmountKbn)
|
|
If z3Cache.Exists(monthAmountKbn) Then
|
|
Me.Cells(rowNum, MMONTH_AMOUNT_KBN_COL).Value = MakeSelect(monthAmountKbn, z3Cache(monthAmountKbn)(0))
|
|
End If
|
|
|
|
Dim dropdowns As Variant
|
|
dropdowns = Array( _
|
|
Array("T", "BuildTransportList"), _
|
|
Array("AB", "BuildTransportList"), _
|
|
Array("AJ", "BuildTransportList"), _
|
|
Array("AR", "BuildTransportList"), _
|
|
Array("G", "BuildTodokeList"), _
|
|
Array("M", "BuildOufukuList"), _
|
|
Array("N", "BuildKoutaiList"), _
|
|
Array("AY", "BuildKetteiList"), _
|
|
Array("BA", "BuildHigaitouList"), _
|
|
Array("BG", "BuildKanshokuList") _
|
|
)
|
|
|
|
Dim i As Long
|
|
For i = LBound(dropdowns) To UBound(dropdowns)
|
|
Dim col As String: col = dropdowns(i)(0)
|
|
Dim funcName As String: funcName = dropdowns(i)(1)
|
|
Dim cellValue As String: cellValue = Trim(Me.Cells(rowNum, col).Value)
|
|
If cellValue = "" Then GoTo NextDropdown
|
|
|
|
Dim key As String: key = GetCode(cellValue)
|
|
If InStr(cellValue, ":") = 0 Then GoTo NextDropdown ' Skip if not key:value format
|
|
|
|
' Get dropdown list
|
|
Dim dropdownList As String: dropdownList = Application.Run(funcName)
|
|
Dim items As Variant: items = Split(dropdownList, ",")
|
|
|
|
' Check if key exists in dropdown
|
|
Dim j As Long
|
|
For j = LBound(items) To UBound(items)
|
|
Dim item As String: item = Trim(items(j))
|
|
If GetCode(item) = key Then
|
|
' Found matching key, update with full key:value
|
|
Me.Cells(rowNum, col).Value = item
|
|
Exit For
|
|
End If
|
|
Next j
|
|
NextDropdown:
|
|
Next i
|
|
End Sub
|
|
|
|
' Fill kukan info from M1 cache (key: kukan code, value: 7 elements)
|
|
Private Sub FillKukanFromM1(ByVal rowNum As Long, ByVal idx As Long)
|
|
Dim m1Cache As Object: Set m1Cache = GetCache("M1")
|
|
|
|
Dim codeCol As Long: codeCol = KUKAN_CODE_COLS(idx)
|
|
Dim transportCol As Long: transportCol = KUKAN_TRANSPORT_COLS(idx)
|
|
Dim stationCol As Long: stationCol = KUKAN_STATION_COLS(idx)
|
|
Dim arrivalCol As Long: arrivalCol = KUKAN_ARRIVAL_COLS(idx)
|
|
Dim ticketCol As Long: ticketCol = KUKAN_TICKET_COLS(idx)
|
|
Dim code2Col As Long: code2Col = KUKAN_CODE2_COLS(idx)
|
|
Dim startDayCol As Long: startDayCol = KUKAN_START_DAY_COLS(idx)
|
|
|
|
Dim code As String: code = Trim(Me.Cells(rowNum, codeCol).Value)
|
|
|
|
If code <> "" And m1Cache.Exists(code) Then
|
|
Dim vals As Variant: vals = m1Cache(code)
|
|
Me.Cells(rowNum, transportCol).Value = MakeSelect(vals(1), vals(2))
|
|
Me.Cells(rowNum, stationCol).Value = Trim(vals(3))
|
|
Me.Cells(rowNum, arrivalCol).Value = Trim(vals(4))
|
|
Call CreateKenshuDropdown(rowNum, idx, code)
|
|
Else
|
|
Me.Cells(rowNum, transportCol).ClearContents
|
|
Me.Cells(rowNum, stationCol).ClearContents
|
|
Me.Cells(rowNum, arrivalCol).ClearContents
|
|
Me.Cells(rowNum, startDayCol).ClearContents
|
|
|
|
Call ClearKukanValidation(rowNum, stationCol)
|
|
Call ClearKukanValidation(rowNum, arrivalCol)
|
|
Call ClearKukanValidation(rowNum, code2Col)
|
|
End If
|
|
|
|
Me.Cells(rowNum, ticketCol).ClearContents
|
|
Me.Cells(rowNum, code2Col).ClearContents
|
|
End Sub
|
|
|
|
' triggered by c clomun cshainno input
|
|
' when cshainno does not exist in o1, clear dropdownList and value
|
|
' when cshainno exist in o1, create dropdownList and value
|
|
Private Sub BuildAddress1Dropdown(ByVal rowNum As Long, ByVal cshainno As String)
|
|
Dim o1Cache As Object: Set o1Cache = GetCache("O1")
|
|
' Build dropdown list from O1 cache: get all E values for the C
|
|
Dim dropdownList As String
|
|
If o1Cache.Exists(cshainno) Then
|
|
Dim innerDict As Object
|
|
Set innerDict = o1Cache(cshainno)
|
|
Dim eKey As Variant
|
|
For Each eKey In innerDict.Keys
|
|
If dropdownList = "" Then
|
|
dropdownList = eKey
|
|
Else
|
|
dropdownList = dropdownList & "," & eKey
|
|
End If
|
|
Next eKey
|
|
End If
|
|
|
|
' Create dropdown for I column address1
|
|
If dropdownList <> "" Then
|
|
With Me.Range("I" & rowNum).Validation
|
|
.Delete
|
|
.Add Type:=xlValidateList, Formula1:=dropdownList
|
|
.IgnoreBlank = True
|
|
.InCellDropdown = True
|
|
.InputTitle = ""
|
|
.InputMessage = ""
|
|
End With
|
|
End If
|
|
End Sub
|
|
|
|
Private Sub ReFillAddress1(ByVal rowNum As Long, ByVal cshainno As String)
|
|
Dim o1Cache As Object: Set o1Cache = GetCache("O1")
|
|
If Not o1Cache.Exists(cshainno) Then
|
|
Me.Cells(rowNum, ADDRESS1_COL).Value = ""
|
|
Exit Sub
|
|
End If
|
|
|
|
Dim innerDict As Object: Set innerDict = o1Cache(cshainno)
|
|
If innerDict.Count = 1 Then
|
|
' Auto-fill if only one key exists
|
|
Dim keys As Variant: keys = innerDict.Keys
|
|
Me.Cells(rowNum, ADDRESS1_COL).Value = keys(0)
|
|
Exit Sub
|
|
End If
|
|
|
|
Dim originalValue As String: originalValue = Trim(Me.Cells(rowNum, ADDRESS1_COL).Value)
|
|
If originalValue = "" Then Exit Sub
|
|
|
|
' Clear if value not found in O1 cache keys
|
|
If Not innerDict.Exists(originalValue) Then
|
|
Me.Cells(rowNum, ADDRESS1_COL).Value = ""
|
|
End If
|
|
End Sub
|
|
|
|
' triggered by address1 select O1 cache
|
|
Private Sub BuildAddress2Dropdown(ByVal rowNum As Long, ByVal cshainno As String)
|
|
' Clear address2 contents
|
|
' obtain cshainno, address1, o1Cache
|
|
Dim o1Cache As Object: Set o1Cache = GetCache("O1")
|
|
Dim address1 As String: address1 = Trim(Me.Cells(rowNum, ADDRESS1_COL).Value)
|
|
If cshainno = "" OR address1 = "" Then
|
|
Exit Sub
|
|
End If
|
|
|
|
' Build dropdown list from O1 cache
|
|
Dim dropdownList As String
|
|
If o1Cache.Exists(cshainno) Then
|
|
Dim innerDict As Object
|
|
Set innerDict = o1Cache(cshainno)
|
|
|
|
If innerDict.Exists(address1) Then
|
|
Dim addr2Dict As Object
|
|
Set addr2Dict = innerDict(address1)
|
|
|
|
Dim addr2Key As Variant
|
|
For Each addr2Key In addr2Dict.Keys
|
|
If dropdownList = "" Then
|
|
dropdownList = addr2Key
|
|
Else
|
|
dropdownList = dropdownList & "," & addr2Key
|
|
End If
|
|
Next addr2Key
|
|
End If
|
|
End If
|
|
|
|
' Create dropdown for J column
|
|
If dropdownList <> "" Then
|
|
With Me.Range("J" & rowNum).Validation
|
|
.Delete
|
|
.Add Type:=xlValidateList, Formula1:=dropdownList
|
|
.IgnoreBlank = True
|
|
.InCellDropdown = True
|
|
.InputTitle = ""
|
|
.InputMessage = ""
|
|
End With
|
|
End If
|
|
End Sub
|
|
|
|
Private Sub ReFillAddress2(ByVal rowNum As Long, ByVal cshainno As String)
|
|
Dim address1 As String: address1 = Trim(Me.Cells(rowNum, ADDRESS1_COL).Value)
|
|
If address1 = "" Then
|
|
Me.Cells(rowNum, ADDRESS2_COL).Value = ""
|
|
Exit Sub
|
|
End If
|
|
|
|
Dim o1Cache As Object: Set o1Cache = GetCache("O1")
|
|
If Not o1Cache.Exists(cshainno) Then
|
|
Me.Cells(rowNum, ADDRESS2_COL).Value = ""
|
|
Exit Sub
|
|
End If
|
|
|
|
Dim innerDict As Object: Set innerDict = o1Cache(cshainno)
|
|
If Not innerDict.Exists(address1) Then
|
|
Me.Cells(rowNum, ADDRESS2_COL).Value = ""
|
|
Exit Sub
|
|
End If
|
|
|
|
Dim addr2Dict As Object: Set addr2Dict = innerDict(address1)
|
|
If addr2Dict.Count = 1 Then
|
|
Dim keys As Variant: keys = addr2Dict.Keys
|
|
Me.Cells(rowNum, ADDRESS2_COL).Value = keys(0)
|
|
Exit Sub
|
|
End If
|
|
|
|
Me.Cells(rowNum, ADDRESS2_COL).Value = ""
|
|
End Sub
|
|
|
|
' Create station from dropdown from M1_KukanD cache
|
|
Private Sub CreateFromStationDropdown(ByVal rowNum As Long, ByVal transportCol As Long, ByVal stationCol As Long)
|
|
Dim m1KukanDCache As Object: Set m1KukanDCache = GetCache("M1KukanDCache")
|
|
|
|
Dim transport As String: transport = GetCode(Me.Cells(rowNum, transportCol).Value)
|
|
If transport = "" Then Exit Sub
|
|
|
|
' Build dropdown list from M1_KukanD cache: get all F values for the transport (D)
|
|
Dim dropdownList As String
|
|
If m1KukanDCache.Exists(transport) Then
|
|
Dim innerDict As Object: Set innerDict = m1KukanDCache(transport)
|
|
Dim fValue As Variant
|
|
For Each fValue In innerDict.Keys
|
|
If dropdownList = "" Then
|
|
dropdownList = fValue
|
|
Else
|
|
dropdownList = dropdownList & "," & fValue
|
|
End If
|
|
Next fValue
|
|
End If
|
|
|
|
If dropdownList <> "" Then
|
|
With Me.Cells(rowNum, stationCol).Validation
|
|
.Delete
|
|
.Add Type:=xlValidateList, Formula1:=dropdownList
|
|
.IgnoreBlank = True
|
|
.InCellDropdown = True
|
|
End With
|
|
End If
|
|
End Sub
|
|
|
|
' Create Kenshu dropdown from
|
|
' Structure: { D: { F: [G] } }
|
|
Private Sub CreateKenshuDropdown(ByVal rowNum As Long, ByVal idx As Long, ByVal kukanCode As String)
|
|
Dim kenshuList As Object: Set kenshuList = GetCache("kenshuList")
|
|
Dim m2Cache As Object: Set m2Cache = GetCache("M2")
|
|
Dim ticketCol As Long: ticketCol = KUKAN_TICKET_COLS(idx)
|
|
|
|
Me.Cells(rowNum, ticketCol).ClearContents
|
|
Call ClearKukanValidation(rowNum, ticketCol)
|
|
|
|
Dim kanshuDict As Object
|
|
if m2Cache.Exists(kukanCode) Then
|
|
Set kanshuDict = m2Cache(kukanCode)
|
|
End If
|
|
|
|
Dim dropdownList As String: dropdownList = MakeSelect("0", kenshuList("0")(0))
|
|
If Not kanshuDict Is Nothing Then
|
|
Dim key As Variant
|
|
For Each key In kenshuList.Keys
|
|
If kanshuDict.Exists(key) Then
|
|
dropdownList = dropdownList & "," & MakeSelect(key, kenshuList(key)(0))
|
|
End If
|
|
Next key
|
|
End If
|
|
|
|
With Me.Cells(rowNum, ticketCol).Validation
|
|
.Delete
|
|
.Add Type:=xlValidateList, Formula1:=dropdownList
|
|
.IgnoreBlank = True
|
|
.InCellDropdown = True
|
|
End With
|
|
End Sub
|
|
|
|
' Create destination dropdown from M1_KukanD cache
|
|
' Structure: { D: { F: [G] } }
|
|
Private Sub CreateToStationDropdown(ByVal rowNum As Long, ByVal transportCol As Long, ByVal stationFromCol As Long, ByVal stationToCol As Long)
|
|
Dim m1KukanDCache As Object: Set m1KukanDCache = GetCache("M1KukanDCache")
|
|
|
|
Dim transport As String: transport = GetCode(Me.Cells(rowNum, transportCol).Value)
|
|
Dim stationFrom As String: stationFrom = GetCode(Me.Cells(rowNum, stationFromCol).Value)
|
|
If transport = "" Or stationFrom = "" Then Exit Sub
|
|
|
|
' Build dropdown list from M1_KukanD cache
|
|
Dim dropdownList As String
|
|
If m1KukanDCache.Exists(transport) Then
|
|
Dim innerDict As Object: Set innerDict = m1KukanDCache(transport)
|
|
If innerDict.Exists(stationFrom) Then
|
|
Dim arr As Object: Set arr = innerDict(stationFrom)
|
|
Dim gValue As Variant
|
|
For Each gValue In arr.Keys
|
|
If dropdownList = "" Then
|
|
dropdownList = gValue
|
|
Else
|
|
dropdownList = dropdownList & "," & gValue
|
|
End If
|
|
Next gValue
|
|
End If
|
|
End If
|
|
|
|
If dropdownList <> "" Then
|
|
With Me.Cells(rowNum, stationToCol).Validation
|
|
.Delete
|
|
.Add Type:=xlValidateList, Formula1:=dropdownList
|
|
.IgnoreBlank = True
|
|
.InCellDropdown = True
|
|
End With
|
|
End If
|
|
End Sub
|
|
|
|
' Find kukan code by transport + station_from + station_to (reverse lookup)
|
|
Private Function FindKukanCodeByStation(ByVal rowNum As Long, ByVal transportCol As Long, ByVal stationFromCol As Long, ByVal stationToCol As Long) As String
|
|
Dim m1Cache As Object: Set m1Cache = GetCache("M1")
|
|
|
|
Dim transportKbn As String: transportKbn = GetCode(Trim(Me.Cells(rowNum, transportCol).Value))
|
|
Dim stationFrom As String: stationFrom = Trim(Me.Cells(rowNum, stationFromCol).Value)
|
|
Dim stationTo As String: stationTo = Trim(Me.Cells(rowNum, stationToCol).Value)
|
|
|
|
If transportKbn = "" Or stationFrom = "" Or stationTo = "" Then
|
|
FindKukanCodeByStation = ""
|
|
Exit Function
|
|
End If
|
|
|
|
Dim code As Variant
|
|
For Each code In m1Cache.Keys
|
|
Dim vals As Variant: vals = m1Cache(code)
|
|
' vals(1) = D列, vals(3) = F列, vals(4) = G列
|
|
If vals(1) = transportKbn And vals(3) = stationFrom And vals(4) = stationTo Then
|
|
FindKukanCodeByStation = code
|
|
Exit Function
|
|
End If
|
|
Next code
|
|
|
|
FindKukanCodeByStation = ""
|
|
End Function
|
|
|
|
' Clear validation for kukan columns
|
|
Private Sub ClearKukanValidation(ByVal rowNum As Long, ByVal col As Long)
|
|
Me.Cells(rowNum, col).Validation.Delete
|
|
End Sub
|
|
|
|
' Create dropdown from M2 cache: get code (J) list for kukanCode + kanshu
|
|
Private Sub BuildM2CodeDropdown(ByVal rowNum As Long, ByVal kukanCodeCol As Long, ByVal kanshuCol As Long, ByVal codeCol As Long)
|
|
Dim m2Cache As Object: Set m2Cache = GetCache("M2")
|
|
|
|
Dim kukanCode As String: kukanCode = Trim(Me.Cells(rowNum, kukanCodeCol).Value)
|
|
Dim kanshuStr As String: kanshuStr = Trim(Me.Cells(rowNum, kanshuCol).Value)
|
|
If kukanCode = "" Or kanshuStr = "" Then Exit Sub
|
|
|
|
' Build dropdown list: get all code for kukanCode + kanshuStr
|
|
Dim dropdownList As String
|
|
If m2Cache.Exists(kukanCode) Then
|
|
Dim innerDict As Object: Set innerDict = m2Cache(kukanCode)
|
|
Dim kanshu As String: kanshu = GetCode(kanshuStr)
|
|
If innerDict.Exists(kanshu) Then
|
|
Dim innermostDict As Object: Set innermostDict = innerDict(kanshu)
|
|
Dim code As Variant
|
|
For Each code In innermostDict.Keys
|
|
Dim infoDict As Object: Set infoDict = innermostDict(code)
|
|
Dim codeName As String: codeName = infoDict("name")
|
|
If dropdownList = "" Then
|
|
dropdownList = MakeSelect(code, codeName)
|
|
Else
|
|
dropdownList = dropdownList & "," & MakeSelect(code, codeName)
|
|
End If
|
|
Next code
|
|
End If
|
|
End If
|
|
|
|
If dropdownList <> "" Then
|
|
With Me.Cells(rowNum, codeCol).Validation
|
|
.Delete
|
|
.Add Type:=xlValidateList, Formula1:=dropdownList
|
|
.IgnoreBlank = True
|
|
.InCellDropdown = True
|
|
End With
|
|
End If
|
|
End Sub
|
|
|
|
Private Sub ReFillM2CodeDropdown(ByVal rowNum As Long, ByVal kukanCodeCol As Long, ByVal kanshuCol As Long, ByVal codeCol As Long)
|
|
Dim m2Cache As Object: Set m2Cache = GetCache("M2")
|
|
|
|
Dim kukanCode As String: kukanCode = Trim(Me.Cells(rowNum, kukanCodeCol).Value)
|
|
Dim kenshu As String: kenshu = GetCode(Trim(Me.Cells(rowNum, kanshuCol).Value))
|
|
If kukanCode = "" Or kenshu = "" Then
|
|
Me.Cells(rowNum, codeCol).ClearContents
|
|
Me.Cells(rowNum, codeCol).Validation.Delete
|
|
Me.Cells(rowNum, codeCol).Interior.Color = vbWhite
|
|
Exit Sub
|
|
End If
|
|
|
|
Dim code As String: code = GetCode(Trim(Me.Cells(rowNum, codeCol).Value))
|
|
If m2Cache.Exists(kukanCode) Then
|
|
Dim innerDict As Object: Set innerDict = m2Cache(kukanCode)
|
|
If innerDict.Exists(kenshu) Then
|
|
Dim innermostDict As Object: Set innermostDict = innerDict(kenshu)
|
|
If innermostDict.Exists(code) Then
|
|
Dim infoDict As Object: Set infoDict = innermostDict(code)
|
|
Dim codeName As String: codeName = infoDict("name")
|
|
Me.Cells(rowNum, codeCol).Value = MakeSelect(code, codeName)
|
|
End IF
|
|
End If
|
|
End If
|
|
|
|
End Sub
|
|
|
|
' Clear row data and validation
|
|
Private Sub ClearRowData(ByVal rowNum As Long)
|
|
Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
|
|
Dim sheetConf As Object: Set sheetConf = sheetConfDict(Me.CodeName)
|
|
|
|
Dim startCol As String: startCol = sheetConf("ErrorCol")
|
|
Dim endCol As String: endCol = sheetConf("EndCol")
|
|
|
|
Me.Range(Me.Cells(rowNum, startCol), Me.Cells(rowNum, endCol)).ClearContents
|
|
Me.Range(Me.Cells(rowNum, startCol), Me.Cells(rowNum, endCol)).Validation.Delete
|
|
Me.Range(Me.Cells(rowNum, startCol), Me.Cells(rowNum, endCol)).Interior.Color = vbWhite
|
|
End Sub
|
|
|
|
' Validation logic
|
|
Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As Long)
|
|
On Error GoTo ErrHandler
|
|
|
|
Dim 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 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 <> "" And Not IsDate(cellDate) 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
|
|
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 z4Cache As Object: Set z4Cache = GetCache("Z4")
|
|
Dim todokeCde As String: todokeCde = GetCode(Trim(Me.Cells(rowNum, ColG).Value))
|
|
If Not z4Cache.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]
|
|
Dim o1Cache As Object: Set o1Cache = GetCache("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)
|
|
If address1 = "" Then
|
|
If address2 <> "" Then
|
|
Me.Cells(rowNum, errorCol).Value = ColJ & " column is invalid"
|
|
Me.Range(ColJ & rowNum).Interior.Color = RGB(255, 0, 0)
|
|
Exit Sub
|
|
End If
|
|
Else
|
|
Dim empNo As String: empNo = Trim(Me.Cells(rowNum, 3).Value)
|
|
If Not o1Cache.Exists(empNo) Then
|
|
Me.Cells(rowNum, errorCol).Value = ColI & " column is invalid"
|
|
Me.Range(ColI & rowNum).Interior.Color = RGB(255, 0, 0)
|
|
Exit Sub
|
|
End If
|
|
|
|
Dim innerDict As Object: Set innerDict = o1Cache(empNo)
|
|
If Not innerDict.Exists(address1) Then
|
|
Me.Cells(rowNum, errorCol).Value = ColI & " column is invalid"
|
|
Me.Range(ColI & rowNum).Interior.Color = RGB(255, 0, 0)
|
|
Exit Sub
|
|
End If
|
|
Dim addr2Dict As Object: Set addr2Dict = innerDict(address1)
|
|
If Not addr2Dict.Exists(address2) Then
|
|
Me.Cells(rowNum, errorCol).Value = ColJ & " column is invalid"
|
|
Me.Range(ColJ & rowNum).Interior.Color = RGB(255, 0, 0)
|
|
Exit Sub
|
|
End If
|
|
End If
|
|
|
|
' K column
|
|
Dim ColK As String: ColK = "K"
|
|
If Trim(Me.Cells(rowNum, ColK).Value) <> "" Then
|
|
Me.Cells(rowNum, errorCol).Value = ColK & " column can not be input"
|
|
Me.Range(ColK & rowNum).Interior.Color = RGB(255, 0, 0)
|
|
Exit Sub
|
|
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
|
|
Dim m1Cache As Object: Set m1Cache = GetCache("M1")
|
|
Dim m2Cache As Object: Set m2Cache = GetCache("M2")
|
|
Dim kukanCols As Variant
|
|
kukanCols = Array(KUKAN_TRANSPORT_COLS, KUKAN_STATION_COLS, KUKAN_ARRIVAL_COLS, KUKAN_TICKET_COLS, KUKAN_CODE2_COLS, KUKAN_START_DAY_COLS)
|
|
|
|
Dim kukanIdx As Long
|
|
For kukanIdx = LBound(KUKAN_CODE_COLS) To UBound(KUKAN_CODE_COLS)
|
|
Dim kukanCol As Long: kukanCol = KUKAN_CODE_COLS(kukanIdx)
|
|
Dim kukanCode As String: kukanCode = Trim(Me.Cells(rowNum, kukanCol).Value)
|
|
Dim kukanLetter As String: kukanLetter = Split(Me.Cells(1, kukanCol).Address, "$")(1)
|
|
|
|
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)
|
|
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)
|
|
|
|
If ticketVal = "" Then
|
|
Me.Cells(rowNum, errorCol).Value = ticketLetter & " column must be input"
|
|
Me.Range(ticketLetter & rowNum).Interior.Color = RGB(255, 0, 0)
|
|
Exit Sub
|
|
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)
|
|
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)
|
|
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)
|
|
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)
|
|
Exit Sub
|
|
Else
|
|
Dim teikiValue As String: teikiValue = Trim(Me.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)
|
|
Exit Sub
|
|
End If
|
|
End If
|
|
End If
|
|
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)
|
|
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)
|
|
Exit Sub
|
|
End If
|
|
Next colGroup
|
|
End If
|
|
Next kukanIdx
|
|
|
|
' Validate KUKAN_CODE_COLS for duplicates (non-empty only)
|
|
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)
|
|
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)
|
|
Exit Sub
|
|
Else
|
|
kukanCodes.Add kukanCode, True
|
|
End If
|
|
End If
|
|
Next kukanIdx
|
|
|
|
' Validate H, BB, BC columns
|
|
Dim linkCellValue As String: linkCellValue = Me.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)
|
|
|
|
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)
|
|
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)
|
|
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)
|
|
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)
|
|
Exit Sub
|
|
End If
|
|
End If
|
|
|
|
Me.Cells(rowNum, errorCol).ClearContents
|
|
Exit Sub
|
|
|
|
ErrHandler:
|
|
lastErrorMsg = Err.Description
|
|
End Sub
|
|
|
|
' Create teiki dropdown based on M2 cache
|
|
Private Sub CreateTeikiDropdown(ByVal row As Long, ByVal idx As Long)
|
|
' Get kukanCode from KUKAN_CODE_COLS
|
|
Dim kukanCol As Long: kukanCol = KUKAN_CODE_COLS(idx)
|
|
Dim kukanCode As String: kukanCode = Trim(Me.Cells(row, kukanCol).Value)
|
|
' Get kenshu from KUKAN_TICKET_COLS
|
|
Dim kenshu As String: kenshu = GetCode(Trim(Me.Cells(row, KUKAN_TICKET_COLS(idx)).Value))
|
|
' Get code2 from KUKAN_CODE2_COLS
|
|
Dim code As String: code = GetCode(Trim(Me.Cells(row, KUKAN_CODE2_COLS(idx)).Value))
|
|
|
|
If kukanCode = "" Or kenshu = "" Or code = "" Then Exit Sub
|
|
If Not kenshu = "1" Then Exit Sub
|
|
|
|
Dim teikiColIndex As Long: teikiColIndex = KUKAN_TEIKI_COLS(idx)
|
|
Call BuildTeikiDropdown(row, kukanCode, kenshu, code, ColLetter(teikiColIndex))
|
|
End Sub
|
|
|
|
Private Sub BuildTeikiDropdown(ByVal rowNum As Long, ByVal kukanCode As String, ByVal kenshu As String, ByVal code As String, ByVal targetCell As String)
|
|
Dim M2Cache As Object: Set M2Cache = GetCache("M2")
|
|
Dim kenshuDict As Object: Set kenshuDict = M2Cache(kukanCode)
|
|
Dim codeDict As Object: Set codeDict = kenshuDict(kenshu)
|
|
Dim teikiArray As Object: Set teikiArray = codeDict(code)
|
|
|
|
If teikiArray Is Nothing Then Exit Sub
|
|
If Not teikiArray.Exists("teikikikanNum") Then Exit Sub
|
|
|
|
Dim teikiList As Variant: teikiList = teikiArray("teikikikanNum")
|
|
If Not IsArray(teikiList) Then Exit Sub
|
|
If UBound(teikiList) < LBound(teikiList) Then Exit Sub
|
|
|
|
' Build dropdown list
|
|
Dim dropdownList As String: dropdownList = ""
|
|
Dim i As Long
|
|
For i = LBound(teikiList) To UBound(teikiList)
|
|
Dim val As String: val = CStr(teikiList(i))
|
|
If val <> "" Then
|
|
If dropdownList = "" Then
|
|
dropdownList = val
|
|
Else
|
|
dropdownList = dropdownList & "," & val
|
|
End If
|
|
End If
|
|
Next i
|
|
|
|
If dropdownList <> "" Then
|
|
With Me.Range(targetCell & rowNum).Validation
|
|
.Delete
|
|
.Add Type:=xlValidateList, Formula1:=dropdownList
|
|
.IgnoreBlank = True
|
|
.InCellDropdown = True
|
|
End With
|
|
End If
|
|
End Sub
|