update C1

2026-04-17 18:58:22 +09:00
parent dd874cf811
commit 54c422d4e9
2 changed files with 103 additions and 21 deletions
--- a/src/thisWorkbook/Tukin_C1.bas
+++ b/src/thisWorkbook/Tukin_C1.bas
@@ -62,6 +62,10 @@ 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
+
 ' ============================================================
 ' Helper: Get index by value, return -1 if not found
 ' ============================================================
@@ -143,18 +147,28 @@ Private Sub Worksheet_Change(ByVal Target As Range)
        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
+                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
-            If Trim(cellK.Value) <> "" Then
-                If Me.Cells(cellK.Row, KUKAN_TRANSPORT_COLS(idx)).Validation.Formula1 <> "" Then
-                    Call FillKukanFromM1(cellK.Row, KUKAN_CODE_COLS(idx), Array(KUKAN_TRANSPORT_COLS(idx), KUKAN_STATION_COLS(idx), KUKAN_ARRIVAL_COLS(idx)))
-                End If
-            Else
-                Call ClearKukanValidation(cellK.Row, KUKAN_TICKET_COLS(idx))
-            End If
+            Call FillKukanFromM1(cellK.Row, idx)
        Next
    End If
    
@@ -166,10 +180,9 @@ Private Sub Worksheet_Change(ByVal Target As Range)
            ' Clear old code first
            Dim code2Col As Long: code2Col = KUKAN_CODE2_COLS(idx)
            Me.Cells(cellTi.Row, code2Col).ClearContents
-            If Trim(cellTi.Value) <> "" Then
+            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)
-            Else
-                Call ClearKukanValidation(cellTi.Row, code2Col)
            End If
        Next
    End If
@@ -205,6 +218,36 @@ Private Sub RebuildDropdownsForTarget(ByVal Target As Range)
                End With
            End If

+            ' --- AA: Transport ---
+            If colLetter <> "AA" Then
+                With Me.Cells(r, "AA").Validation
+                    .Delete
+                    .Add Type:=xlValidateList, Formula1:=BuildTransportList()
+                    .IgnoreBlank = True
+                    .InCellDropdown = True
+                End With
+            End If
+
+            ' --- AH: Transport ---
+            If colLetter <> "AH" Then
+                With Me.Cells(r, "AH").Validation
+                    .Delete
+                    .Add Type:=xlValidateList, Formula1:=BuildTransportList()
+                    .IgnoreBlank = True
+                    .InCellDropdown = True
+                End With
+            End If
+
+            ' --- AO: Transport ---
+            If colLetter <> "AO" Then
+                With Me.Cells(r, "AO").Validation
+                    .Delete
+                    .Add Type:=xlValidateList, Formula1:=BuildTransportList()
+                    .IgnoreBlank = True
+                    .InCellDropdown = True
+                End With
+            End If
+
            ' --- G: todoke ---
            If colLetter <> "G" Then
                With Me.Cells(r, "G").Validation
@@ -281,22 +324,35 @@ NextCell:
 End Sub

 ' Fill kukan info from M1 cache (key: kukan code, value: 7 elements)
-Private Sub FillKukanFromM1(ByVal rowNum As Long, ByVal codeCol As Long, ByVal fillCols As Variant)
+Private Sub FillKukanFromM1(ByVal rowNum As Long, ByVal idx As Long)
    If m1Cache Is Nothing Then Call RefreshM1Cache
    
-    Dim code As String: code = Trim(Me.Cells(rowNum, codeCol).Value)
-    If code = "" Then Exit Sub
+    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)
    
-    If m1Cache.Exists(code) Then
+    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)
-        ' value(1):value(2) -> fillCols(0)
-        Me.Cells(rowNum, fillCols(0)).Value = MakeSelect(vals(1), vals(2))
-        ' value(3) -> fillCols(1)
-        Me.Cells(rowNum, fillCols(1)).Value = Trim(vals(3))
-        ' value(4) -> fillCols(2)
-        Me.Cells(rowNum, fillCols(2)).Value = Trim(vals(4))
+        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))
    Else
-        Me.Cells(rowNum, codeCol).ClearContents
+        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
 End Sub

@@ -548,6 +604,32 @@ Private Sub CreateToStationDropdown(ByVal rowNum As Long, ByVal transportCol As
    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
+    If m1Cache Is Nothing Then Call RefreshM1Cache
+    
+    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
--- a/通勤手当テンプレート_案.xlsm
+++ b/通勤手当テンプレート_案.xlsm