update C1

2026-04-17 12:30:18 +09:00
parent 0ef1b45031
commit 8b894ada0a
5 changed files with 63 additions and 84 deletions
--- a/src/module/Global_Cache.bas
+++ b/src/module/Global_Cache.bas
@@ -126,7 +126,7 @@ Public Sub RefreshM2Cache()
        Dim kukanCode As String: kukanCode = Trim(wsM2.Cells(r, 3).Value)  ' C column
        Dim kanshu As String: kanshu = Trim(wsM2.Cells(r, 9).Value)       ' I column
        Dim code As String: code = Trim(wsM2.Cells(r, 10).Value)         ' J column
-        Dim kValue As String: kValue = Trim(wsM2.Cells(r, 11).Value)      ' K column
+        Dim name As String: name = Trim(wsM2.Cells(r, 11).Value)      ' K column
        
        If kukanCode = "" Or kanshu = "" Or code = "" Then GoTo NextRow
        
@@ -143,10 +143,10 @@ Public Sub RefreshM2Cache()
            innerDict.Add kanshu, innermostDict
        End If
        
-        ' Inner level: code -> kValue
+        ' Inner level: code -> name
        Set innermostDict = innerDict(kanshu)
        If Not innermostDict.Exists(code) Then
-            innermostDict.Add code, kValue
+            innermostDict.Add code, name
        End If
        
 NextRow:
--- a/src/module/Module_Common.bas
+++ b/src/module/Module_Common.bas
@@ -237,3 +237,8 @@ Sub AutoFitColumnWidth(ByVal fitColumnStart As Long, ByVal fitColumnEnd As Long)
        ws.Range(ws.Columns(fitColumnStart), ws.Columns(fitColumnEnd)).AutoFit
    End If
 End Sub
+
+' Format: code:value (no space around colon)
+Function MakeSelect(ByVal code As String, ByVal value As String) As String
+    MakeSelect = Trim(code) & ":" & Trim(value)
+End Function
--- a/src/thisWorkbook/Tukin_C1.bas
+++ b/src/thisWorkbook/Tukin_C1.bas
@@ -87,12 +87,12 @@ Private Sub Worksheet_Change(ByVal Target As Range)
        Dim cell As Range
        For Each cell In Target
            If Trim(cell.Value) = "" Then
-                Call ClearRowData(Me, cell.Row)
+                Call ClearRowData(cell.Row)
            Else
                Call FillAddressFromO1(cell.Row)
                Dim i As Long
                For i = 0 To 3
-                    Call CreateZ1TransportDropdown(Me, cell.Row, KUKAN_TRANSPORT_COLS(i))
+                    Call CreateZ1TransportDropdown(cell.Row, KUKAN_TRANSPORT_COLS(i))
                Next i
            End If
        Next
@@ -105,9 +105,9 @@ Private Sub Worksheet_Change(ByVal Target As Range)
        Dim cellT As Range
        For Each cellT In Target
            If Trim(cellT.Value) <> "" Then
-                Call CreateZ1StationDropdown(Me, cellT.Row, KUKAN_TRANSPORT_COLS(idx), KUKAN_STATION_COLS(idx))
+                Call CreateZ1StationDropdown(cellT.Row, KUKAN_TRANSPORT_COLS(idx), KUKAN_STATION_COLS(idx))
            Else
-                Call ClearKukanValidation(Me, cellT.Row, KUKAN_STATION_COLS(idx))
+                Call ClearKukanValidation(cellT.Row, KUKAN_STATION_COLS(idx))
            End If
        Next
    End If
@@ -118,12 +118,15 @@ Private Sub Worksheet_Change(ByVal Target As Range)
        Dim cellU As Range
        For Each cellU In Target
            If Trim(cellU.Value) <> "" Then
-                Call CreateM1KukanDDropdown(Me, cellU.Row, KUKAN_TRANSPORT_COLS(idx), KUKAN_STATION_COLS(idx), KUKAN_ARRIVAL_COLS(idx))
-                If Me.Cells(cellU.Row, KUKAN_ARRIVAL_COLS(idx)).Validation.Formula1 = "" Then
-                    Call ClearKukanValidation(Me, cellU.Row, KUKAN_ARRIVAL_COLS(idx))
+                Call CreateM1KukanDDropdown(cellU.Row, KUKAN_TRANSPORT_COLS(idx), KUKAN_STATION_COLS(idx), KUKAN_ARRIVAL_COLS(idx))
+                On Error Resume Next
+                Dim formula As String: formula = Me.Cells(cellU.Row, KUKAN_ARRIVAL_COLS(idx)).Validation.Formula1
+                On Error GoTo 0
+                If formula = "" Then
+                    Call ClearKukanValidation(cellU.Row, KUKAN_ARRIVAL_COLS(idx))
                End If
            Else
-                Call ClearKukanValidation(Me, cellU.Row, KUKAN_ARRIVAL_COLS(idx))
+                Call ClearKukanValidation(cellU.Row, KUKAN_ARRIVAL_COLS(idx))
            End If
        Next
    End If
@@ -134,13 +137,12 @@ Private Sub Worksheet_Change(ByVal Target As Range)
        Dim cellK As Range
        For Each cellK In Target
            If Trim(cellK.Value) <> "" Then
-                Call CreateZ1TransportDropdown(Me, cellK.Row, KUKAN_TRANSPORT_COLS(idx))
+                Call CreateZ1TransportDropdown(cellK.Row, KUKAN_TRANSPORT_COLS(idx))
                If Me.Cells(cellK.Row, KUKAN_TRANSPORT_COLS(idx)).Validation.Formula1 <> "" Then
-                    Call FillKukanFromM1(Me, cellK.Row, KUKAN_CODE_COLS(idx), Array(KUKAN_TRANSPORT_COLS(idx), KUKAN_STATION_COLS(idx), KUKAN_ARRIVAL_COLS(idx)))
-                    Call CreateM2Dropdown(Me, cellK.Row, KUKAN_CODE_COLS(idx), KUKAN_TICKET_COLS(idx))
+                    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(Me, cellK.Row, KUKAN_TICKET_COLS(idx))
+                Call ClearKukanValidation(cellK.Row, KUKAN_TICKET_COLS(idx))
            End If
        Next
    End If
@@ -150,65 +152,35 @@ Private Sub Worksheet_Change(ByVal Target As Range)
    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
            If Trim(cellTi.Value) <> "" Then
-                Call CreateM2CodeDropdown(Me, cellTi.Row, KUKAN_CODE_COLS(idx), KUKAN_TICKET_COLS(idx), KUKAN_CODE2_COLS(idx))
+                Call CreateM2CodeDropdown(cellTi.Row, KUKAN_CODE_COLS(idx), KUKAN_TICKET_COLS(idx), code2Col)
            Else
-                Call ClearKukanValidation(Me, cellTi.Row, KUKAN_CODE2_COLS(idx))
+                Call ClearKukanValidation(cellTi.Row, code2Col)
            End If
        Next
    End If
 End Sub

 ' Fill kukan info from M1 cache (key: kukan code, value: 7 elements)
-Private Sub FillKukanFromM1(ByVal ws As Worksheet, ByVal rowNum As Long, ByVal codeCol As Long, ByVal fillCols As Variant)
+Private Sub FillKukanFromM1(ByVal rowNum As Long, ByVal codeCol As Long, ByVal fillCols As Variant)
    If m1Cache Is Nothing Then Call RefreshM1Cache
    
-    Dim code As String: code = Trim(ws.Cells(rowNum, codeCol).Value)
+    Dim code As String: code = Trim(Me.Cells(rowNum, codeCol).Value)
    If code = "" Then Exit Sub
    
    If m1Cache.Exists(code) Then
        Dim vals As Variant: vals = m1Cache(code)
        ' value(1):value(2) -> fillCols(0)
-        ws.Cells(rowNum, fillCols(0)).Value = Trim(vals(1)) & ": " & Trim(vals(2))
+        Me.Cells(rowNum, fillCols(0)).Value = MakeSelect(vals(1), vals(2))
        ' value(3) -> fillCols(1)
-        ws.Cells(rowNum, fillCols(1)).Value = Trim(vals(3))
+        Me.Cells(rowNum, fillCols(1)).Value = Trim(vals(3))
        ' value(4) -> fillCols(2)
-        ws.Cells(rowNum, fillCols(2)).Value = Trim(vals(4))
+        Me.Cells(rowNum, fillCols(2)).Value = Trim(vals(4))
    Else
-        ws.Cells(rowNum, codeCol).ClearContents
-    End If
-End Sub
-
-' Create dropdown from M2 cache for ticket type column
-Private Sub CreateM2Dropdown(ByVal ws As Worksheet, ByVal rowNum As Long, ByVal kukanCodeCol As Long, ByVal ticketCol As Long)
-    If m2Cache Is Nothing Then Call RefreshM2Cache
-    
-    Dim kukanCode As String: kukanCode = Trim(ws.Cells(rowNum, kukanCodeCol).Value)
-    If kukanCode = "" Then Exit Sub
-    
-    ' Build dropdown list: get all kanshu (券種) for the kukanCode
-    Dim dropdownList As String
-    If m2Cache.Exists(kukanCode) Then
-        Dim innerDict As Object: Set innerDict = m2Cache(kukanCode)
-        Dim kanshu As Variant
-        For Each kanshu In innerDict.Keys
-            If dropdownList = "" Then
-                dropdownList = kanshu
-            Else
-                dropdownList = dropdownList & "," & kanshu
-            End If
-        Next kanshu
-    End If
-    
-    If dropdownList <> "" Then
-        With ws.Range(ws.Cells(rowNum, ticketCol).Address).Validation
-            .Delete
-            .Add Type:=xlValidateList, Formula1:=dropdownList
-            .IgnoreBlank = True
-            .InCellDropdown = True
-            .InputTitle = ""
-            .InputMessage = ""
-        End With
+        Me.Cells(rowNum, codeCol).ClearContents
    End If
 End Sub

@@ -249,22 +221,24 @@ Private Sub FillAddressFromO1(ByVal rowNum As Long)
 End Sub

 ' Create transport (T) dropdown from Z1 cache
-Private Sub CreateZ1TransportDropdown(ByVal ws As Worksheet, ByVal rowNum As Long, ByVal col As Long)
+Private Sub CreateZ1TransportDropdown(ByVal rowNum As Long, ByVal col As Long)
    If z1Cache Is Nothing Then Call RefreshZ1Cache
    
-    ' Build dropdown list from Z1 cache keys
+    ' Build dropdown list: 区分:交通機関名称
    Dim dropdownList As String
    Dim key As Variant
    For Each key In z1Cache.Keys
+        Dim displayText As String
+        displayText = MakeSelect(key, z1Cache(key)(0))
        If dropdownList = "" Then
-            dropdownList = key
+            dropdownList = displayText
        Else
-            dropdownList = dropdownList & "," & key
+            dropdownList = dropdownList & "," & displayText
        End If
    Next key
    
    If dropdownList <> "" Then
-        With ws.Cells(rowNum, col).Validation
+        With Me.Cells(rowNum, col).Validation
            .Delete
            .Add Type:=xlValidateList, Formula1:=dropdownList
            .IgnoreBlank = True
@@ -276,10 +250,10 @@ Private Sub CreateZ1TransportDropdown(ByVal ws As Worksheet, ByVal rowNum As Lon
 End Sub

 ' Create station (利用区間発) dropdown from M1_KukanD cache
-Private Sub CreateZ1StationDropdown(ByVal ws As Worksheet, ByVal rowNum As Long, ByVal transportCol As Long, ByVal stationCol As Long)
+Private Sub CreateZ1StationDropdown(ByVal rowNum As Long, ByVal transportCol As Long, ByVal stationCol As Long)
    If m1KukanDCache Is Nothing Then Call RefreshM1KukanDCache
    
-    Dim transport As String: transport = Trim(ws.Cells(rowNum, transportCol).Value)
+    Dim transport As String: transport = Trim(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)
@@ -297,7 +271,7 @@ Private Sub CreateZ1StationDropdown(ByVal ws As Worksheet, ByVal rowNum As Long,
    End If
    
    If dropdownList <> "" Then
-        With ws.Cells(rowNum, stationCol).Validation
+        With Me.Cells(rowNum, stationCol).Validation
            .Delete
            .Add Type:=xlValidateList, Formula1:=dropdownList
            .IgnoreBlank = True
@@ -308,11 +282,11 @@ End Sub

 ' Create destination (利用区間着) dropdown from M1_KukanD cache
 ' Structure: { D: { F: [G] } }
-Private Sub CreateM1KukanDDropdown(ByVal ws As Worksheet, ByVal rowNum As Long, ByVal transportCol As Long, ByVal stationFromCol As Long, ByVal stationToCol As Long)
+Private Sub CreateM1KukanDDropdown(ByVal rowNum As Long, ByVal transportCol As Long, ByVal stationFromCol As Long, ByVal stationToCol As Long)
    If m1KukanDCache Is Nothing Then Call RefreshM1KukanDCache
    
-    Dim transport As String: transport = Trim(ws.Cells(rowNum, transportCol).Value)
-    Dim stationFrom As String: stationFrom = Trim(ws.Cells(rowNum, stationFromCol).Value)
+    Dim transport As String: transport = Trim(Me.Cells(rowNum, transportCol).Value)
+    Dim stationFrom As String: stationFrom = Trim(Me.Cells(rowNum, stationFromCol).Value)
    If transport = "" Or stationFrom = "" Then Exit Sub
    
    ' Build dropdown list from M1_KukanD cache
@@ -333,7 +307,7 @@ Private Sub CreateM1KukanDDropdown(ByVal ws As Worksheet, ByVal rowNum As Long,
    End If
    
    If dropdownList <> "" Then
-        With ws.Cells(rowNum, stationToCol).Validation
+        With Me.Cells(rowNum, stationToCol).Validation
            .Delete
            .Add Type:=xlValidateList, Formula1:=dropdownList
            .IgnoreBlank = True
@@ -343,16 +317,16 @@ Private Sub CreateM1KukanDDropdown(ByVal ws As Worksheet, ByVal rowNum As Long,
 End Sub

 ' Clear validation for kukan columns
-Private Sub ClearKukanValidation(ByVal ws As Worksheet, ByVal rowNum As Long, ByVal col As Long)
-    ws.Cells(rowNum, col).Validation.Delete
+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 ws As Worksheet, ByVal rowNum As Long, ByVal kukanCodeCol As Long, ByVal kanshuCol As Long, ByVal codeCol As Long)
+Private Sub CreateM2CodeDropdown(ByVal rowNum As Long, ByVal kukanCodeCol As Long, ByVal kanshuCol As Long, ByVal codeCol As Long)
    If m2Cache Is Nothing Then Call RefreshM2Cache
    
-    Dim kukanCode As String: kukanCode = Trim(ws.Cells(rowNum, kukanCodeCol).Value)
-    Dim kanshu As String: kanshu = Trim(ws.Cells(rowNum, kanshuCol).Value)
+    Dim kukanCode As String: kukanCode = Trim(Me.Cells(rowNum, kukanCodeCol).Value)
+    Dim kanshu As String: kanshu = Trim(Me.Cells(rowNum, kanshuCol).Value)
    If kukanCode = "" Or kanshu = "" Then Exit Sub
    
    ' Build dropdown list: get all code for kukanCode + kanshu
@@ -364,7 +338,7 @@ Private Sub CreateM2CodeDropdown(ByVal ws As Worksheet, ByVal rowNum As Long, By
            Dim code As Variant
            For Each code In innermostDict.Keys
                If dropdownList = "" Then
-                    dropdownList = code
+                    dropdownList = MakeSelect(code, innermostDict(code))
                Else
                    dropdownList = dropdownList & "," & code
                End If
@@ -373,7 +347,7 @@ Private Sub CreateM2CodeDropdown(ByVal ws As Worksheet, ByVal rowNum As Long, By
    End If
    
    If dropdownList <> "" Then
-        With ws.Cells(rowNum, codeCol).Validation
+        With Me.Cells(rowNum, codeCol).Validation
            .Delete
            .Add Type:=xlValidateList, Formula1:=dropdownList
            .IgnoreBlank = True
@@ -382,9 +356,9 @@ Private Sub CreateM2CodeDropdown(ByVal ws As Worksheet, ByVal rowNum As Long, By
    End If
 End Sub
 ' Clear row data
-Private Sub ClearRowData(ByVal ws As Worksheet, ByVal rowNum As Long)
-    ws.Range(ws.Cells(rowNum, 4), ws.Cells(rowNum, END_COL)).ClearContents
-    ws.Cells(rowNum, ERROR_COL).ClearContents
+Private Sub ClearRowData(ByVal rowNum As Long)
+    Me.Range(Me.Cells(rowNum, 4), Me.Cells(rowNum, END_COL)).ClearContents
+    Me.Cells(rowNum, ERROR_COL).ClearContents
 End Sub

 ' ====== Button Macros ======
@@ -413,21 +387,21 @@ Private Sub Validate(ByVal rowNum As Long)
    Set ws = Me
    
    ' Clear background color
-    ws.Range(ws.Cells(rowNum, START_COL), ws.Cells(rowNum, END_COL)).Interior.Color = vbWhite
+    Me.Range(Me.Cells(rowNum, START_COL), Me.Cells(rowNum, END_COL)).Interior.Color = vbWhite
    
    ' Required columns: C-G, K-N, AW
    Dim requiredCols As Variant
    requiredCols = Array("C", "D", "E", "F", "G", "K", "L", "M", "N", "AW")
    Dim col As Variant
    For Each col In requiredCols
-        If Trim(ws.Range(col & rowNum).Value & "") = "" Then
-            ws.Cells(rowNum, ERROR_COL).Value = col & " column is required"
-            ws.Range(col & rowNum).Interior.Color = RGB(255, 0, 0)
+        If Trim(Me.Range(col & rowNum).Value & "") = "" Then
+            Me.Cells(rowNum, ERROR_COL).Value = col & " column is required"
+            Me.Range(col & rowNum).Interior.Color = RGB(255, 0, 0)
            Exit Sub
        End If
    Next col
    
-    ws.Cells(rowNum, ERROR_COL).ClearContents
+    Me.Cells(rowNum, ERROR_COL).ClearContents
 End Sub

 Sub C1_SortDataRowsByC()
--- a/src/thisWorkbook/Tukin_Cache_Mapping.md
+++ b/src/thisWorkbook/Tukin_Cache_Mapping.md
@@ -15,7 +15,7 @@
 ### m2Cache
 |列|C列|I列|J列|K列|
 |--------|--------|--------|--------|--------|
-|ヘッダ|区間コード|券種|コード|1箇月運賃|
+|ヘッダ|区間コード|券種|コード|名称|

 ### z1Cache (222)交通機関マスタ
 |列|C列|D列|
--- a/通勤手当テンプレート_案.xlsm
+++ b/通勤手当テンプレート_案.xlsm