update C1

This commit is contained in:
updsv7
2026-04-17 18:58:22 +09:00
parent dd874cf811
commit 54c422d4e9
2 changed files with 103 additions and 21 deletions

View File

@@ -62,6 +62,10 @@ Private Function KUKAN_CODE2_COLS() As Variant
KUKAN_CODE2_COLS = Array(24, 31, 38, 45) ' X, AE, AL, AS KUKAN_CODE2_COLS = Array(24, 31, 38, 45) ' X, AE, AL, AS
End Function 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 ' Helper: Get index by value, return -1 if not found
' ============================================================ ' ============================================================
@@ -143,18 +147,28 @@ Private Sub Worksheet_Change(ByVal Target As Range)
Next Next
End If 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) === ' === Kukan code column changes (S, Z, AG, AN) ===
idx = GetIdx(Target.Column, KUKAN_CODE_COLS) idx = GetIdx(Target.Column, KUKAN_CODE_COLS)
If idx >= 0 Then If idx >= 0 Then
Dim cellK As Range Dim cellK As Range
For Each cellK In Target For Each cellK In Target
If Trim(cellK.Value) <> "" Then Call FillKukanFromM1(cellK.Row, idx)
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
Next Next
End If End If
@@ -166,10 +180,9 @@ Private Sub Worksheet_Change(ByVal Target As Range)
' Clear old code first ' Clear old code first
Dim code2Col As Long: code2Col = KUKAN_CODE2_COLS(idx) Dim code2Col As Long: code2Col = KUKAN_CODE2_COLS(idx)
Me.Cells(cellTi.Row, code2Col).ClearContents 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) Call CreateM2CodeDropdown(cellTi.Row, KUKAN_CODE_COLS(idx), KUKAN_TICKET_COLS(idx), code2Col)
Else
Call ClearKukanValidation(cellTi.Row, code2Col)
End If End If
Next Next
End If End If
@@ -205,6 +218,36 @@ Private Sub RebuildDropdownsForTarget(ByVal Target As Range)
End With End With
End If 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 --- ' --- G: todoke ---
If colLetter <> "G" Then If colLetter <> "G" Then
With Me.Cells(r, "G").Validation With Me.Cells(r, "G").Validation
@@ -281,22 +324,35 @@ NextCell:
End Sub End Sub
' Fill kukan info from M1 cache (key: kukan code, value: 7 elements) ' 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 If m1Cache Is Nothing Then Call RefreshM1Cache
Dim code As String: code = Trim(Me.Cells(rowNum, codeCol).Value) Dim codeCol As Long: codeCol = KUKAN_CODE_COLS(idx)
If code = "" Then Exit Sub 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) Dim vals As Variant: vals = m1Cache(code)
' value(1):value(2) -> fillCols(0) Me.Cells(rowNum, transportCol).Value = MakeSelect(vals(1), vals(2))
Me.Cells(rowNum, fillCols(0)).Value = MakeSelect(vals(1), vals(2)) Me.Cells(rowNum, stationCol).Value = Trim(vals(3))
' value(3) -> fillCols(1) Me.Cells(rowNum, arrivalCol).Value = Trim(vals(4))
Me.Cells(rowNum, fillCols(1)).Value = Trim(vals(3))
' value(4) -> fillCols(2)
Me.Cells(rowNum, fillCols(2)).Value = Trim(vals(4))
Else 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 If
End Sub End Sub
@@ -548,6 +604,32 @@ Private Sub CreateToStationDropdown(ByVal rowNum As Long, ByVal transportCol As
End If End If
End Sub 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 ' Clear validation for kukan columns
Private Sub ClearKukanValidation(ByVal rowNum As Long, ByVal col As Long) Private Sub ClearKukanValidation(ByVal rowNum As Long, ByVal col As Long)
Me.Cells(rowNum, col).Validation.Delete Me.Cells(rowNum, col).Validation.Delete