diff --git a/src/thisWorkbook/Tukin_C1.bas b/src/thisWorkbook/Tukin_C1.bas index 7390910..439b853 100644 --- 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 diff --git a/通勤手当テンプレート_案.xlsm b/通勤手当テンプレート_案.xlsm index ad0bd1c..414b7c7 100644 Binary files a/通勤手当テンプレート_案.xlsm and b/通勤手当テンプレート_案.xlsm differ