20260515指摘対応4

src/sh/tuk/module/Common_Global_Cache.bas

@@ -514,7 +514,7 @@ Private Sub RefreshSheetDict()
 
     ' Enum
     Set sheetConf = Nothing
-    sheetConfDict("Enum") = Array("tokubetuList", "kenshuList", "oufukuList", "koutaiList", "higaitouList", "errorList")
+    sheetConfDict("Enum") = Array("tokubetuList", "kenshuList", "renrakuList", "oufukuList", "koutaiList", "higaitouList", "errorList")
     Debug.Print "RefreshSheetDict Enum ok."
 
     ' tokubetuList
@@ -533,35 +533,43 @@ Private Sub RefreshSheetDict()
     Set sheetConfDict("kenshuList") = sheetConf
     Debug.Print "RefreshSheetDict kenshuList ok."
 
-    ' oufukuList
+    ' renrakuList
     Set sheetConf = CreateObject("Scripting.Dictionary")
     sheetConf("StartRow") = 3
     sheetConf("KeyCol") = 6
-    sheetConf("ValueCols") = Array(7)
+    sheetConf("ValueCols") = Array(6)
+    Set sheetConfDict("renrakuList") = sheetConf
+    Debug.Print "RefreshSheetDict renrakuList ok."
+
+    ' oufukuList
+    Set sheetConf = CreateObject("Scripting.Dictionary")
+    sheetConf("StartRow") = 3
+    sheetConf("KeyCol") = 8
+    sheetConf("ValueCols") = Array(9)
     Set sheetConfDict("oufukuList") = sheetConf
     Debug.Print "RefreshSheetDict oufukuList ok."
 
     ' koutaiList
     Set sheetConf = CreateObject("Scripting.Dictionary")
     sheetConf("StartRow") = 3
-    sheetConf("KeyCol") = 9
+    sheetConf("KeyCol") = 11
-    sheetConf("ValueCols") = Array(10)
+    sheetConf("ValueCols") = Array(12)
     Set sheetConfDict("koutaiList") = sheetConf
     Debug.Print "RefreshSheetDict koutaiList ok."
 
     ' higaitouList
     Set sheetConf = CreateObject("Scripting.Dictionary")
     sheetConf("StartRow") = 3
-    sheetConf("KeyCol") = 12
+    sheetConf("KeyCol") = 14
-    sheetConf("ValueCols") = Array(13)
+    sheetConf("ValueCols") = Array(15)
     Set sheetConfDict("higaitouList") = sheetConf
     Debug.Print "RefreshSheetDict higaitouList ok."
 
     ' errorList
     Set sheetConf = CreateObject("Scripting.Dictionary")
     sheetConf("StartRow") = 3
-    sheetConf("KeyCol") = 15
+    sheetConf("KeyCol") = 17
-    sheetConf("ValueCols") = Array(16)
+    sheetConf("ValueCols") = Array(18)
     Set sheetConfDict("errorList") = sheetConf
     Debug.Print "RefreshSheetDict errorList ok."
 
@@ -577,7 +585,7 @@ Public Function RefreshAllCache(Optional ByVal activeSheetName As String = "") A
     ' Fixed cache names
     Dim fixedCaches As Variant
     fixedCaches = Array("Z1", "Z2", "Z3", "Z4", "T1", "T2", "T3", "O1", "O2", _
-        "tokubetuList", "kenshuList", "oufukuList", "koutaiList", "higaitouList", "errorList")
+        "tokubetuList", "kenshuList", "renrakuList", "oufukuList", "koutaiList", "higaitouList", "errorList")
     
     ' Dynamic cache names based on activeSheet
     Dim dynamicCaches As Variant

src/sh/tuk/module/Common_Selector.bas

@@ -1,21 +1,24 @@
 Attribute VB_Name = "Common_Selector"
 Option Explicit
 ' ============================================================
-' Module Name: Build_Select
+' Module Name: Common_Selector
-' Module Desc: Commuter allowance editing sheet (no CSV import)
+' Module Desc: Build dropdown lists from cache data
 ' Module Methods:
-'   - Tukin_ValidateRow
+'   - BuildTransportList
-'   - FillTransportFromM1KukanD
+'   - BuildTodokeList
-'   - FillDepartureFromM1KukanD
+'   - BuildOufukuList
-'   - FillArrivalFromM1KukanD
+'   - BuildKoutaiList
-'   - FillKukanFromM1
+'   - BuildKetteiList
-'   - FillKanshuFromM2
+'   - BuildHigaitouList
-'   - FillCodeFromM2
+'   - BuildMonthAmountKbnList
-'   - FillAddressFromO1
+'   - BuildKanshokuList
-'   - FillZ1Dropdown
+'   - BuildKenshuList
 ' ============================================================
 
-' Create transport (T) dropdown from Z1 cache
+' ============================================================
+' Event Handlers
+' ============================================================
+' Create Transport (T) dropdown from Z1 cache
 Public Function BuildTransportList()
     Dim z1Cache As Object: Set z1Cache = GetCache("Z1")
 
@@ -34,7 +37,7 @@ Public Function BuildTransportList()
     BuildTransportList = dropdownList
 End Function
 
-' Create todoke (G) dropdown
+' Create Todoke (G) dropdown
 Public Function BuildTodokeList()
     Dim z4Cache As Object: Set z4Cache = GetCache("Z4")
 
@@ -52,7 +55,7 @@ Public Function BuildTodokeList()
     BuildTodokeList = dropdownList
 End Function
 
-' Create oufuku (M) dropdown
+' Create Oufuku (M) dropdown
 Public Function BuildOufukuList()
     Dim oufukuList As Object: Set oufukuList = GetCache("oufukuList")
 
@@ -159,3 +162,54 @@ Public Function BuildKanshokuList()
     Next key
     BuildKanshokuList = dropdownList
 End Function
+
+' Create Kenshu dropdown (exclude key = 0)
+Public Sub BuildKenshuDropdown(ws As Worksheet, ByVal columnLetter As String, ByVal rowNum As Long)
+    Dim kenshuList As Object: Set kenshuList = GetCache("kenshuList")
+
+    Dim dropdownList As String
+    Dim key As Variant
+    For Each key In kenshuList.Keys
+        If key <> 0 Then
+            Dim displayText As String
+            displayText = MakeSelect(key, kenshuList(key)(0))
+            If dropdownList = "" Then
+                dropdownList = displayText
+            Else
+                dropdownList = dropdownList & "," & displayText
+            End If
+        End If
+    Next key
+
+    With ws.Range(columnLetter & rowNum).Validation
+        .Delete
+        .Add Type:=xlValidateList, Formula1:=dropdownList
+        .IgnoreBlank = True
+        .InCellDropdown = True
+        .InputTitle = ""
+        .InputMessage = ""
+    End With
+End Sub
+
+' Create Kenshu dropdown (exclude key = 0)
+Public Sub BuildTokubetuDropdown(ws As Worksheet, ByVal columnLetter As String, ByVal rowNum As Long)
+    Dim tokubetuList As Object: Set tokubetuList = GetCache("tokubetuList")
+    Dim dropdownList As String: dropdownList = ""
+    Dim key As Variant
+    For Each key In tokubetuList.Keys
+        If dropdownList = "" Then
+            dropdownList = key
+        Else
+            dropdownList = dropdownList & "," & key
+        End If
+    Next key
+    
+    With ws.Range(columnLetter & rowNum).Validation
+        .Delete
+        .Add Type:=xlValidateList, Formula1:=dropdownList
+        .IgnoreBlank = True
+        .InCellDropdown = True
+        .InputTitle = ""
+        .InputMessage = ""
+    End With
+End Sub

src/sh/tuk/sheet/M1.cls

@@ -7,34 +7,6 @@
 '   - Validate
 ' ============================================================
 
-' Create dropdown for L column
-Private Sub CreateEnumDropdown(ByVal rowNum As Long)
-    Dim tokubetuList As Object: Set tokubetuList = GetCache("tokubetuList")
-    ' Build dropdown list from tokubetuList
-    Dim dropdownList As String
-    dropdownList = ""
-
-    Dim key As Variant
-    For Each key In tokubetuList.Keys
-        If dropdownList = "" Then
-            dropdownList = key
-        Else
-            dropdownList = dropdownList & "," & key
-        End If
-    Next key
-
-    With Me.Range("L" & rowNum).Validation
-        .Delete
-        .Add Type:=xlValidateList, Formula1:=dropdownList
-        .IgnoreBlank = True
-        .InCellDropdown = True
-        .InputTitle = ""
-        .InputMessage = ""
-    End With
-
-End Sub
-
-'
 Private Sub Worksheet_Change(ByVal Target As Range)
     Dim HasHeaderEdit As Boolean: HasHeaderEdit = CheckHeaderEdit(Me, Target)
     If HasHeaderEdit = True Then Exit Sub
@@ -47,7 +19,7 @@ Private Sub Worksheet_Change(ByVal Target As Range)
                 Me.Cells(cell.Row, 12).Validation.Delete
                 Call ClearDataRow(Me, START_COL + 1, END_COL, cell.Row, ERROR_COL)
             Else
-                Call CreateEnumDropdown(cell.Row)
+                Call BuildTokubetuDropdown(Me, "L", cell.Row)
             End If
         Next
     End If

src/sh/tuk/sheet/M2.cls

@@ -37,6 +37,7 @@ Private Sub Worksheet_Change(ByVal Target As Range)
                 GoTo Finally
             Else
                 Call FillFromM1(Me, cell.Row)
+                Call BuildKenshuDropdown(Me, "I", cell.Row)
             End If
         Next
     End If
@@ -45,6 +46,11 @@ Private Sub Worksheet_Change(ByVal Target As Range)
     If Target.Column = 9 Then
         Dim cellI As Range
         For Each cellI In Target
+            ' Store key only (e.g., "1") in I column
+            Dim kenshuKey As String: kenshuKey = GetCode(cellI.Value)
+            If kenshuKey <> "" Then
+                cellI.Value = kenshuKey
+            End If
             ' clear
             Me.Range(Me.Cells(cellI.Row, 10), Me.Cells(cellI.Row, 18)).ClearContents
             Me.Cells(cellI.Row, 11).Validation.Delete
@@ -61,7 +67,7 @@ Private Sub Worksheet_Change(ByVal Target As Range)
         Next
     End If
 
-    Dim kenshuKbn As String: kenshuKbn = Trim(Me.Range("I" & Target.Row).value)
+    Dim kenshuKbn As String: kenshuKbn = Trim(Me.Range("I" & Target.Row).Value)
     Dim restrictedCols As Range
     If kenshuKbn = "1" Then
         Set restrictedCols = Union(Me.Columns("K"), Me.Columns("O"), Me.Columns("P"), Me.Columns("Q"), Me.Columns("R"))
@@ -281,15 +287,6 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
         End If
     Next col
 
-    ' Check I column in the kenshuKbn
-    Dim kenshuList As Object: Set kenshuList = GetCache("kenshuList")
-    Dim kenshuKbn As String: kenshuKbn = Trim(ws.Range("I" & rowNum).Value)
-    If Not kenshuList.Exists(kenshuKbn) Then
-        ws.Cells(rowNum, errorCol).Value = GetErrorMsg("E012", "I" & rowNum)
-        ws.Range("I" & rowNum).Interior.Color = RGB(255, 0, 0)
-        Exit Sub
-    End If
-
     ' Check J column in the T1, T2, T3
     Dim code As String: code = Trim(ws.Range("J" & rowNum).Value)
     Dim name As String: name = Trim(ws.Range("K" & rowNum).Value)