diff --git a/src/module/Global_Cache.bas b/src/module/Global_Cache.bas index 4f9a125..bf87e6c 100644 --- 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: diff --git a/src/module/Module_Common.bas b/src/module/Module_Common.bas index 337733b..2b2b7ae 100644 --- 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 diff --git a/src/thisWorkbook/Tukin_C1.bas b/src/thisWorkbook/Tukin_C1.bas index 77f44ea..2a532bb 100644 --- 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() diff --git a/src/thisWorkbook/Tukin_Cache_Mapping.md b/src/thisWorkbook/Tukin_Cache_Mapping.md index 2a860d2..7bdd81d 100644 --- 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列| diff --git a/通勤手当テンプレート_案.xlsm b/通勤手当テンプレート_案.xlsm index f16a78c..e82221c 100644 Binary files a/通勤手当テンプレート_案.xlsm and b/通勤手当テンプレート_案.xlsm differ