879 lines
33 KiB
OpenEdge ABL
879 lines
33 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
|
|
' - CreateAddress1Dropdown
|
|
' - FillZ1Dropdown
|
|
' ============================================================
|
|
' ====== (Tukin_C1) =======
|
|
' Commuter allowance editing sheet
|
|
' No CSV import - direct editing only
|
|
' ============================================================
|
|
' Column arrays for 4 kukan sections
|
|
' ============================================================
|
|
Private Function KUKAN_CODE_COLS() As Variant
|
|
KUKAN_CODE_COLS = Array(19, 26, 33, 40) ' S, Z, AG, AN
|
|
End Function
|
|
|
|
Private Function KUKAN_TRANSPORT_COLS() As Variant
|
|
KUKAN_TRANSPORT_COLS = Array(20, 27, 34, 41) ' T, AA, AH, AO
|
|
End Function
|
|
|
|
Private Function KUKAN_STATION_COLS() As Variant
|
|
KUKAN_STATION_COLS = Array(21, 28, 35, 42) ' U, AB, AI, AP
|
|
End Function
|
|
|
|
Private Function KUKAN_ARRIVAL_COLS() As Variant
|
|
KUKAN_ARRIVAL_COLS = Array(22, 29, 36, 43) ' V, AC, AJ, AQ
|
|
End Function
|
|
|
|
Private Function KUKAN_TICKET_COLS() As Variant
|
|
KUKAN_TICKET_COLS = Array(23, 30, 37, 44) ' W, AD, AK, AR
|
|
End Function
|
|
|
|
Private Function KUKAN_CODE2_COLS() As Variant
|
|
KUKAN_CODE2_COLS = Array(24, 31, 38, 45) ' X, AE, AL, AS
|
|
End Function
|
|
|
|
Private Function KUKAN_START_DAY_COLS() As Variant
|
|
KUKAN_START_DAY_COLS = Array(25, 32, 39, 46) ' Y, AF, AM, AT
|
|
End Function
|
|
|
|
Private Function DATE_COLS() As Variant
|
|
DATE_COLS = Array(4, 5, 6, 25, 32, 39, 46, 51, 54) ' D, E, F, Y, AF, AM, AT, AY, BB
|
|
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 watchArea As Range
|
|
With Me
|
|
Set watchArea = Union( _
|
|
.Columns("C"), _
|
|
.Columns("D"), _
|
|
.Columns("E"), _
|
|
.Columns("F"), _
|
|
.Columns("G"), _
|
|
.Columns("I"), _
|
|
.Columns("S:W"), _
|
|
.Columns("Z:AD"), _
|
|
.Columns("AG:AK"), _
|
|
.Columns("AN:AR"), _
|
|
.Columns("BB") _
|
|
)
|
|
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
|
|
|
|
Application.EnableEvents = False
|
|
On Error GoTo Finally
|
|
|
|
Call CreateNinteiDropdown(Target)
|
|
|
|
' === 3. rebuild dropdown list ===
|
|
Call RebuildDropdownsForTarget(Target)
|
|
|
|
' === Column C changes ===
|
|
If Target.Column = 3 Then
|
|
Dim cell As Range
|
|
For Each cell In Target
|
|
If Trim(cell.Value) = "" Then
|
|
Call ClearRowData(cell.Row)
|
|
Else
|
|
Call CreateAddress1Dropdown(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 = GetZ4Cache()
|
|
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 CreateAddress2Dropdown(cellI.Row)
|
|
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, AA, AH, AO) ===
|
|
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, AB, AI, AP) ===
|
|
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, AC, AJ, AQ) ===
|
|
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, Z, AG, AN) ===
|
|
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, AD, AK, AR) ===
|
|
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
|
|
Call CreateM2CodeDropdown(cellTi.Row, KUKAN_CODE_COLS(idx), KUKAN_TICKET_COLS(idx), code2Col)
|
|
Next
|
|
End If
|
|
|
|
Finally:
|
|
Application.EnableEvents = True '
|
|
End Sub
|
|
|
|
Private Sub RebuildDropdownsForTarget(ByVal Target As Range)
|
|
If Target Is Nothing Then Exit Sub
|
|
|
|
Dim cell As Range
|
|
Dim processedRows As Object
|
|
Set processedRows = CreateObject("Scripting.Dictionary")
|
|
|
|
For Each cell In Target
|
|
Dim r As Long
|
|
r = cell.Row
|
|
|
|
If Not processedRows.Exists(r) Then
|
|
processedRows(r) = True
|
|
|
|
Dim colLetter As String
|
|
colLetter = Split(Me.Cells(1, cell.Column).Address(True, False), "$")(0)
|
|
|
|
Dim dropdowns As Variant
|
|
dropdowns = Array( _
|
|
Array("T", "BuildTransportList"), _
|
|
Array("AA", "BuildTransportList"), _
|
|
Array("AH", "BuildTransportList"), _
|
|
Array("AO", "BuildTransportList"), _
|
|
Array("G", "BuildTodokeList"), _
|
|
Array("M", "BuildOufukuList"), _
|
|
Array("N", "BuildKoutaiList"), _
|
|
Array("AU", "BuildKetteiList"), _
|
|
Array("AW", "BuildHigaitouList"), _
|
|
Array("AX", "BuildMonthAmountKbnList"), _
|
|
Array("BC", "BuildKanshokuList") _
|
|
)
|
|
|
|
Dim i As Long
|
|
For i = LBound(dropdowns) To UBound(dropdowns)
|
|
If colLetter <> dropdowns(i)(0) Then
|
|
With Me.Cells(r, dropdowns(i)(0)).Validation
|
|
.Delete
|
|
.Add Type:=xlValidateList, Formula1:=Application.Run(dropdowns(i)(1))
|
|
.IgnoreBlank = True
|
|
.InCellDropdown = True
|
|
End With
|
|
End If
|
|
Next i
|
|
|
|
End If
|
|
NextCell:
|
|
Next cell
|
|
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 = GetM1Cache()
|
|
|
|
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
|
|
Private Sub CreateAddress1Dropdown(ByVal rowNum As Long)
|
|
Dim o1Cache As Object: Set o1Cache = GetO1Cache()
|
|
|
|
Dim empNo As String
|
|
empNo = Trim(Me.Cells(rowNum, 3).Value)
|
|
If empNo = "" Then Exit Sub
|
|
|
|
' Build dropdown list from O1 cache: get all E values for the C
|
|
Dim dropdownList As String
|
|
If o1Cache.Exists(empNo) Then
|
|
Dim innerDict As Object
|
|
Set innerDict = o1Cache(empNo)
|
|
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
|
|
|
|
' triggered by address1 select O1 cache
|
|
Private Sub CreateAddress2Dropdown(ByVal rowNum As Long)
|
|
Dim o1Cache As Object: Set o1Cache = GetO1Cache()
|
|
|
|
Dim empNo As String
|
|
empNo = Trim(Me.Cells(rowNum, 3).Value)
|
|
If empNo = "" Then
|
|
Me.Range("J" & rowNum).Validation.Delete
|
|
Me.Range("J" & rowNum).Value = ""
|
|
Exit Sub
|
|
End If
|
|
|
|
Dim addr1 As String
|
|
addr1 = Trim(Me.Cells(rowNum, 9).Value)
|
|
Me.Range("J" & rowNum).Value = ""
|
|
If addr1 = "" Then
|
|
Me.Range("J" & rowNum).Validation.Delete
|
|
Exit Sub
|
|
End If
|
|
|
|
' Build dropdown list from O1 cache
|
|
Dim dropdownList As String
|
|
If o1Cache.Exists(empNo) Then
|
|
Dim innerDict As Object
|
|
Set innerDict = o1Cache(empNo)
|
|
|
|
If innerDict.Exists(addr1) Then
|
|
Dim addr2Dict As Object
|
|
Set addr2Dict = innerDict(addr1)
|
|
|
|
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
|
|
|
|
' 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 = GetM1KukanDCache()
|
|
|
|
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 = GetKenshuList()
|
|
Dim m2Cache As Object: Set m2Cache = GetM2Cache()
|
|
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 Nintei dropdown from ninteiKbnList if H3 cell Validation does not exist
|
|
Private Sub CreateNinteiDropdown(ByVal Target As Range)
|
|
Dim ninteiKbnList As Object: Set ninteiKbnList = GetNinteiKbnList()
|
|
|
|
' Build dropdown list from ninteiKbnList
|
|
Dim dropdownList As String
|
|
Dim key As Variant
|
|
For Each key In ninteiKbnList.Keys
|
|
Dim displayText As String
|
|
displayText = MakeSelect(key, ninteiKbnList(key)(0))
|
|
If dropdownList = "" Then
|
|
dropdownList = displayText
|
|
Else
|
|
dropdownList = dropdownList & "," & displayText
|
|
End If
|
|
Next key
|
|
|
|
If dropdownList <> "" Then
|
|
With Me.Range("H3").Validation
|
|
.Delete
|
|
.Add Type:=xlValidateList, Formula1:=dropdownList
|
|
.IgnoreBlank = True
|
|
.InCellDropdown = True
|
|
End With
|
|
End If
|
|
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 = GetM1KukanDCache()
|
|
|
|
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 = GetM1Cache()
|
|
|
|
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 CreateM2CodeDropdown(ByVal rowNum As Long, ByVal kukanCodeCol As Long, ByVal kanshuCol As Long, ByVal codeCol As Long)
|
|
Dim m2Cache As Object: Set m2Cache = GetM2Cache()
|
|
|
|
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
|
|
If dropdownList = "" Then
|
|
dropdownList = MakeSelect(code, innermostDict(code))
|
|
Else
|
|
dropdownList = dropdownList & "," & code
|
|
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
|
|
|
|
' 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(ws.CodeName)
|
|
|
|
Dim startCol As String: startCol = sheetConf("StartCol")
|
|
Dim endCol As String: endCol = sheetConf("EndCol")
|
|
Dim errorCol As String: errorCol = sheetConf("ErrorCol")
|
|
|
|
Me.Range(Me.Cells(rowNum, startCol), Me.Cells(rowNum, endCol)).ClearContents
|
|
Me.Cells(rowNum, errorCol).ClearContents
|
|
|
|
Dim clearValidationCols As Variant
|
|
clearValidationCols = Array("I", "J", "U", "V", "X", "AB", "AC", "AE", "AI", "AJ", "AL", "AP", "AQ", "AS")
|
|
Dim col As Variant
|
|
For Each col In clearValidationCols
|
|
Me.Range(col & rowNum).Validation.Delete
|
|
Next col
|
|
End Sub
|
|
|
|
' Validation logic
|
|
Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As Long)
|
|
|
|
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", "AW")
|
|
Dim col As Variant
|
|
For Each col In requiredCols
|
|
If Trim(Me.Range(col & rowNum).Value & "") = "" Then
|
|
Me.Cells(rowNum, errorCol).Value = col & " column is required"
|
|
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 = letter & " column is invalid"
|
|
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 = col & " column is invalid"
|
|
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 = GetZ4Cache()
|
|
Dim todokeCde As String: todokeCde = GetCode(Trim(Me.Cells(rowNum, ColG).Value))
|
|
If Not z4Cache.Exists(todokeCde) Then
|
|
Me.Cells(rowNum, errorCol).Value = ColG & " column is invalid"
|
|
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 = GetO1Cache()
|
|
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 = GetOufukuList()
|
|
Dim oufukuCde As String: oufukuCde = GetCode(Trim(Me.Cells(rowNum, ColM).Value))
|
|
If Not oufukuList.Exists(oufukuCde) Then
|
|
Me.Cells(rowNum, errorCol).Value = ColM & " column is invalid"
|
|
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 = GetKoutaiList()
|
|
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 = GetM1Cache()
|
|
Dim m2Cache As Object: Set m2Cache = GetM2Cache()
|
|
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 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
|
|
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 = kukanLetter & " column is duplicated"
|
|
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 ColH As String: ColH = "H"
|
|
Dim ColBB As String: ColBB = "BB"
|
|
Dim ColBC As String: ColBC = "BC"
|
|
Dim codeH As String: codeH = GetCode(Trim(Me.Cells(3, ColH).Value))
|
|
Dim valBB As String: valBB = Trim(Me.Cells(rowNum, ColBB).Value)
|
|
Dim valBC As String: valBC = Trim(Me.Cells(rowNum, ColBC).Value)
|
|
|
|
Me.Range("H3").Interior.Color = vbWhite
|
|
If codeH = "" Then
|
|
MsgBox "Please select cell " & ColH & "3 column", vbExclamation
|
|
Me.Range("H3").Interior.Color = RGB(255, 0, 0)
|
|
Exit Sub
|
|
End If
|
|
If codeH = "1" Then
|
|
' If code = "1", BB and BC must be empty
|
|
If valBB <> "" Then
|
|
Me.Cells(rowNum, errorCol).Value = ColBB & " column must be empty"
|
|
Me.Range(ColBB & rowNum).Interior.Color = RGB(255, 0, 0)
|
|
Exit Sub
|
|
End If
|
|
If valBC <> "" Then
|
|
Me.Cells(rowNum, errorCol).Value = ColBC & " column must be empty"
|
|
Me.Range(ColBC & rowNum).Interior.Color = RGB(255, 0, 0)
|
|
Exit Sub
|
|
End If
|
|
ElseIf codeH = "2" Then
|
|
' If code = "2", BB and BC must have value
|
|
If valBB = "" Then
|
|
Me.Cells(rowNum, errorCol).Value = ColBB & " column is required"
|
|
Me.Range(ColBB & rowNum).Interior.Color = RGB(255, 0, 0)
|
|
Exit Sub
|
|
End If
|
|
If valBC = "" Then
|
|
Me.Cells(rowNum, errorCol).Value = ColBC & " column is required"
|
|
Me.Range(ColBC & rowNum).Interior.Color = RGB(255, 0, 0)
|
|
Exit Sub
|
|
End If
|
|
End If
|
|
|
|
Me.Cells(rowNum, errorCol).ClearContents
|
|
End Sub
|