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

refactor

Browse Source
This commit is contained in:
updsv7
2026-04-23 21:02:16 +09:00
parent c6d53813e3
commit ae56faf697
23 changed files with 424 additions and 34 deletions
Download Patch File Download Diff File Expand all files Collapse all files

846
src/sh/tuk/sheet/C1.cls Normal file
View File

@@ -0,0 +1,846 @@
' ============================================================
' 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
' ============================================================
Const CSHAINNO_COL As String = "C"
Const ADDRESS1_COL As String = "I"
Const ADDRESS2_COL As String = "J"
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 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: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
' === 3. rebuild dropdown list ===
Call RebuildDropdownsForTarget(Target)
' === 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
Call CreateAddress1Dropdown(cell.Row, cshainno)
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 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 = 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 CreateAddress1Dropdown(ByVal rowNum As Long, ByVal cshainno As String)
Dim o1Cache As Object: Set o1Cache = GetCache("O1")
Me.Range("I" & rowNum).Validation.Delete
Me.Range("I" & rowNum).Value = ""
Me.Range("J" & rowNum).Validation.Delete
Me.Range("J" & rowNum).Value = ""
' 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
' triggered by address1 select O1 cache
Private Sub CreateAddress2Dropdown(ByVal rowNum As Long)
' Clear address2 contents
Me.Range(ADDRESS2_COL & rowNum).Validation.Delete
Me.Range(ADDRESS2_COL & rowNum).Value = ""
' obtain cshainno, address1, o1Cache
Dim o1Cache As Object: Set o1Cache = GetCache("O1")
Dim cshainno As String: cshainno = Trim(Me.Cells(rowNum, CSHAINNO_COL).Value)
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
' 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 CreateM2CodeDropdown(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
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(Me.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.Range(Me.Cells(rowNum, startCol), Me.Cells(rowNum, endCol)).Interior.Color = vbWhite
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 = 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 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 = 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 ColBB As String: ColBB = "BB"
Dim ColBC As String: ColBC = "BC"
Dim valBB As String: valBB = Trim(Me.Cells(rowNum, ColBB).Value)
Dim valBC As String: valBC = Trim(Me.Cells(rowNum, ColBC).Value)
If linkCellValue = "1" Then
' If code = "1", BB and BC must be empty
If valBB <> "" Then
Me.Cells(rowNum, errorCol).Value = GetErrorMsg("E005", ColBB & rowNum)
Me.Range(ColBB & rowNum).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
If valBC <> "" Then
Me.Cells(rowNum, errorCol).Value = GetErrorMsg("E005", ColBC & rowNum)
Me.Range(ColBC & 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 valBB = "" Then
Me.Cells(rowNum, errorCol).Value = GetErrorMsg("E002", ColBB & rowNum)
Me.Range(ColBB & rowNum).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
If valBC = "" Then
Me.Cells(rowNum, errorCol).Value = GetErrorMsg("E002", ColBC & rowNum)
Me.Range(ColBC & rowNum).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
End If
Me.Cells(rowNum, errorCol).ClearContents
End Sub