add kenshuList

src/init_module/Import_modules.bas

@@ -5,7 +5,7 @@ Sub ImportModulesAndSheets_Safe()
     Dim fso As Object
     Set fso = CreateObject("Scripting.FileSystemObject")
     
-    Const PROJECT_PATH As String = "E:\AI\project\updsv7\vba\"
+    Const PROJECT_PATH As String = "D:\Project\upds7\vba\"
     Const MODULE_PATH As String = PROJECT_PATH & "src\module"
     Const SHEET_PATH As String = PROJECT_PATH & "src\sheet"
     

src/module/Common_Global_Cache.bas

@@ -29,6 +29,7 @@ Private tokubetuList As Object
 Private oufukuList As Object
 Private koutaiList As Object
 Private higaitouList As Object
+Private kenshuList As Object
 
 Private sheetConfDict As Object
 
@@ -277,7 +278,7 @@ Private Sub RefreshO1Cache()
         End If
         
         Set arr = innerDict(eVal)
-        If fVal <> "" And Not arr.Exists(fVal) Then
+        If Not arr.Exists(fVal) Then
             arr.Add fVal, True
         End If
         
@@ -377,6 +378,24 @@ RefreshError:
     Err.Raise 1001, "GetHigaitouList", "Failed to load Enum lookup cache: " & Err.Description
 End Sub
 
+' ============================================================
+' higaitouList
+' ============================================================
+Private Sub RefreshKenshuList()
+    On Error GoTo RefreshError
+    Set kenshuList = LoadLookup("Enum", keyCol:=3, valueCols:=Array(4), startRow:=3)
+    On Error GoTo 0
+
+    If kenshuList Is Nothing Or kenshuList.Count = 0 Then
+        Err.Raise 1003, "RefreshKenshuList", "Enum reference data is empty"
+    End If
+
+    Exit Sub
+
+RefreshError:
+    Err.Raise 1001, "RefreshKenshuList", "Failed to load Enum lookup cache: " & Err.Description
+End Sub
+
 Private Sub RefreshSheetDict()
     Set sheetConfDict = CreateObject("Scripting.Dictionary")
     Dim sheetConf As Object
@@ -612,4 +631,9 @@ End Function
 Public Function GetTokubetu() As Object
     If tokubetuList Is Nothing Then Call RefreshTokubetu
     Set GetTokubetu = tokubetuList
+End Function
+
+Public Function GetKenshuList() As Object
+    If kenshuList Is Nothing Then Call RefreshKenshuList
+    Set GetKenshuList = kenshuList
 End Function

src/sheet/C1.cls

@@ -191,6 +191,7 @@ Private Sub Worksheet_Change(ByVal Target As Range)
                 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
@@ -214,9 +215,7 @@ Private Sub Worksheet_Change(ByVal Target As Range)
             Dim code2Col As Long: code2Col = KUKAN_CODE2_COLS(idx)
             Me.Cells(cellTi.Row, code2Col).ClearContents
             Me.Cells(cellTi.Row, code2Col).Validation.Delete
-            If Not IsError(Application.Match(cellTi.Value, Array("1", "2", "3"), 0)) Then
+            Call CreateM2CodeDropdown(cellTi.Row, KUKAN_CODE_COLS(idx), KUKAN_TICKET_COLS(idx), code2Col)
-                Call CreateM2CodeDropdown(cellTi.Row, KUKAN_CODE_COLS(idx), KUKAN_TICKET_COLS(idx), code2Col)
-            End If
         Next
     End If
 
@@ -292,18 +291,20 @@ Private Sub FillKukanFromM1(ByVal rowNum As Long, ByVal idx As Long)
         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, ticketCol).ClearContents
-        Me.Cells(rowNum, code2Col).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
@@ -427,6 +428,39 @@ Private Sub CreateFromStationDropdown(ByVal rowNum As Long, ByVal transportCol A
     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 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)
@@ -499,13 +533,14 @@ Private Sub CreateM2CodeDropdown(ByVal rowNum As Long, ByVal kukanCodeCol As Lon
     Dim m2Cache As Object: Set m2Cache = GetM2Cache()
     
     Dim kukanCode As String: kukanCode = Trim(Me.Cells(rowNum, kukanCodeCol).Value)
-    Dim kanshu As String: kanshu = Trim(Me.Cells(rowNum, kanshuCol).Value)
+    Dim kanshuStr As String: kanshuStr = Trim(Me.Cells(rowNum, kanshuCol).Value)
-    If kukanCode = "" Or kanshu = "" Then Exit Sub
+    If kukanCode = "" Or kanshuStr = "" Then Exit Sub
     
-    ' Build dropdown list: get all code for kukanCode + kanshu
+    ' 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
@@ -599,15 +634,12 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
     ' validate CodeSelect
     ' G column [todoke Cde]
     Dim ColG As String: ColG = "G"
-    Dim todoke As String: todoke = Trim(Me.Cells(rowNum, ColG).Value)
+    Dim z4Cache As Object: Set z4Cache = GetZ4Cache()
-    If todoke <> "" Then
+    Dim todokeCde As String: todokeCde = GetCode(Trim(Me.Cells(rowNum, ColG).Value))
-      Dim z4Cache As Object: Set z4Cache = GetZ4Cache()
+    If Not z4Cache.Exists(todokeCde) Then
-      Dim todokeCde As String: todokeCde = GetCode(todoke)
+    Me.Cells(rowNum, errorCol).Value = ColG & " column is invalid"
-      If Not z4Cache.Exists(todokeCde) Then
+    Me.Range(ColG & rowNum).Interior.Color = RGB(255, 0, 0)
-        Me.Cells(rowNum, errorCol).Value = ColG & " column is invalid"
+    Exit Sub
-        Me.Range(ColG & rowNum).Interior.Color = RGB(255, 0, 0)
-        Exit Sub
-      End If
     End If
 
     ' I column [address1 J column address2]
@@ -645,25 +677,116 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
     End If
 
     ' K column
-    If Trim(Me.Cells(rowNum, "K").Value) <> "" Then
+    Dim ColK As String: ColK = "K"
-      Me.Cells(rowNum, errorCol).Value = "K" & " column can not be input"
+    If Trim(Me.Cells(rowNum, ColK).Value) <> "" Then
-      Me.Range("K" & rowNum).Interior.Color = RGB(255, 0, 0)
+      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 [todoke Cde]
+    ' M column [oufuku]
-    Dim ColG As String: ColG = "G"
+    Dim ColM As String: ColM = "M"
-    Dim todoke As String: todoke = Trim(Me.Cells(rowNum, ColG).Value)
+    Dim oufukuList As Object: Set oufukuList = GetOufukuList()
-    If todoke <> "" Then
+    Dim oufukuCde As String: oufukuCde = GetCode(Trim(Me.Cells(rowNum, ColM).Value))
-      Dim z4Cache As Object: Set z4Cache = GetZ4Cache()
+    If Not oufukuList.Exists(oufukuCde) Then
-      Dim todokeCde As String: todokeCde = GetCode(todoke)
+    Me.Cells(rowNum, errorCol).Value = ColM & " column is invalid"
-      If Not z4Cache.Exists(todokeCde) Then
+    Me.Range(ColM & rowNum).Interior.Color = RGB(255, 0, 0)
-        Me.Cells(rowNum, errorCol).Value = ColG & " column is invalid"
+    Exit Sub
-        Me.Range(ColG & rowNum).Interior.Color = RGB(255, 0, 0)
-        Exit Sub
-      End If
     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
+
     Me.Cells(rowNum, errorCol).ClearContents
 End Sub