20260515指摘対応4

2026-05-18 12:24:18 +09:00
parent 553148202c
commit b359ae916b
5 changed files with 94 additions and 63 deletions
--- a/src/sh/tuk/module/Common_Global_Cache.bas
+++ b/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("ValueCols") = Array(10)
+    sheetConf("KeyCol") = 11
+    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("ValueCols") = Array(13)
+    sheetConf("KeyCol") = 14
+    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("ValueCols") = Array(16)
+    sheetConf("KeyCol") = 17
+    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
--- a/src/sh/tuk/module/Common_Selector.bas
+++ b/src/sh/tuk/module/Common_Selector.bas
@@ -1,21 +1,24 @@
 Attribute VB_Name = "Common_Selector"
 Option Explicit
 ' ============================================================
-' Module Name: Build_Select
-' Module Desc: Commuter allowance editing sheet (no CSV import)
+' Module Name: Common_Selector
+' Module Desc: Build dropdown lists from cache data
 ' Module Methods:
-'   - Tukin_ValidateRow
-'   - FillTransportFromM1KukanD
-'   - FillDepartureFromM1KukanD
-'   - FillArrivalFromM1KukanD
-'   - FillKukanFromM1
-'   - FillKanshuFromM2
-'   - FillCodeFromM2
-'   - FillAddressFromO1
-'   - FillZ1Dropdown
+'   - BuildTransportList
+'   - BuildTodokeList
+'   - BuildOufukuList
+'   - BuildKoutaiList
+'   - BuildKetteiList
+'   - BuildHigaitouList
+'   - BuildMonthAmountKbnList
+'   - BuildKanshokuList
+'   - 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
--- a/src/sh/tuk/sheet/M1.cls
+++ b/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
--- a/src/sh/tuk/sheet/M2.cls
+++ b/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)