diff --git a/src/sh/tuk/module/Common_Global_Cache.bas b/src/sh/tuk/module/Common_Global_Cache.bas index 2310d70..f252071 100644 --- a/src/sh/tuk/module/Common_Global_Cache.bas +++ b/src/sh/tuk/module/Common_Global_Cache.bas @@ -514,7 +514,7 @@ Private Sub RefreshSheetDict() ' Enum Set sheetConf = Nothing - sheetConfDict("Enum") = Array("tokubetuList", "kenshuList", "oufukuList", "koutaiList", "higaitouList", "errorList") + sheetConfDict("Enum") = Array("tokubetuList", "kenshuList", "renrakuList", "oufukuList", "koutaiList", "higaitouList", "errorList") Debug.Print "RefreshSheetDict Enum ok." ' tokubetuList @@ -533,35 +533,43 @@ Private Sub RefreshSheetDict() Set sheetConfDict("kenshuList") = sheetConf Debug.Print "RefreshSheetDict kenshuList ok." - ' oufukuList + ' renrakuList Set sheetConf = CreateObject("Scripting.Dictionary") sheetConf("StartRow") = 3 sheetConf("KeyCol") = 6 - sheetConf("ValueCols") = Array(7) + sheetConf("ValueCols") = Array(6) + Set sheetConfDict("renrakuList") = sheetConf + Debug.Print "RefreshSheetDict renrakuList ok." + + ' oufukuList + Set sheetConf = CreateObject("Scripting.Dictionary") + sheetConf("StartRow") = 3 + sheetConf("KeyCol") = 8 + sheetConf("ValueCols") = Array(9) Set sheetConfDict("oufukuList") = sheetConf Debug.Print "RefreshSheetDict oufukuList ok." ' koutaiList Set sheetConf = CreateObject("Scripting.Dictionary") sheetConf("StartRow") = 3 - sheetConf("KeyCol") = 9 - sheetConf("ValueCols") = Array(10) + sheetConf("KeyCol") = 11 + sheetConf("ValueCols") = Array(12) Set sheetConfDict("koutaiList") = sheetConf Debug.Print "RefreshSheetDict koutaiList ok." ' higaitouList Set sheetConf = CreateObject("Scripting.Dictionary") sheetConf("StartRow") = 3 - sheetConf("KeyCol") = 12 - sheetConf("ValueCols") = Array(13) + sheetConf("KeyCol") = 14 + sheetConf("ValueCols") = Array(15) Set sheetConfDict("higaitouList") = sheetConf Debug.Print "RefreshSheetDict higaitouList ok." ' errorList Set sheetConf = CreateObject("Scripting.Dictionary") sheetConf("StartRow") = 3 - sheetConf("KeyCol") = 15 - sheetConf("ValueCols") = Array(16) + sheetConf("KeyCol") = 17 + sheetConf("ValueCols") = Array(18) Set sheetConfDict("errorList") = sheetConf Debug.Print "RefreshSheetDict errorList ok." @@ -577,7 +585,7 @@ Public Function RefreshAllCache(Optional ByVal activeSheetName As String = "") A ' Fixed cache names Dim fixedCaches As Variant fixedCaches = Array("Z1", "Z2", "Z3", "Z4", "T1", "T2", "T3", "O1", "O2", _ - "tokubetuList", "kenshuList", "oufukuList", "koutaiList", "higaitouList", "errorList") + "tokubetuList", "kenshuList", "renrakuList", "oufukuList", "koutaiList", "higaitouList", "errorList") ' Dynamic cache names based on activeSheet Dim dynamicCaches As Variant diff --git a/src/sh/tuk/module/Common_Selector.bas b/src/sh/tuk/module/Common_Selector.bas index 9299c78..ce47a06 100644 --- a/src/sh/tuk/module/Common_Selector.bas +++ b/src/sh/tuk/module/Common_Selector.bas @@ -1,21 +1,24 @@ Attribute VB_Name = "Common_Selector" Option Explicit ' ============================================================ -' Module Name: Build_Select -' Module Desc: Commuter allowance editing sheet (no CSV import) +' Module Name: Common_Selector +' Module Desc: Build dropdown lists from cache data ' Module Methods: -' - Tukin_ValidateRow -' - FillTransportFromM1KukanD -' - FillDepartureFromM1KukanD -' - FillArrivalFromM1KukanD -' - FillKukanFromM1 -' - FillKanshuFromM2 -' - FillCodeFromM2 -' - FillAddressFromO1 -' - FillZ1Dropdown +' - BuildTransportList +' - BuildTodokeList +' - BuildOufukuList +' - BuildKoutaiList +' - BuildKetteiList +' - BuildHigaitouList +' - BuildMonthAmountKbnList +' - BuildKanshokuList +' - BuildKenshuList ' ============================================================ -' Create transport (T) dropdown from Z1 cache +' ============================================================ +' Event Handlers +' ============================================================ +' Create Transport (T) dropdown from Z1 cache Public Function BuildTransportList() Dim z1Cache As Object: Set z1Cache = GetCache("Z1") @@ -34,7 +37,7 @@ Public Function BuildTransportList() BuildTransportList = dropdownList End Function -' Create todoke (G) dropdown +' Create Todoke (G) dropdown Public Function BuildTodokeList() Dim z4Cache As Object: Set z4Cache = GetCache("Z4") @@ -52,7 +55,7 @@ Public Function BuildTodokeList() BuildTodokeList = dropdownList End Function -' Create oufuku (M) dropdown +' Create Oufuku (M) dropdown Public Function BuildOufukuList() Dim oufukuList As Object: Set oufukuList = GetCache("oufukuList") @@ -159,3 +162,54 @@ Public Function BuildKanshokuList() Next key BuildKanshokuList = dropdownList End Function + +' Create Kenshu dropdown (exclude key = 0) +Public Sub BuildKenshuDropdown(ws As Worksheet, ByVal columnLetter As String, ByVal rowNum As Long) + Dim kenshuList As Object: Set kenshuList = GetCache("kenshuList") + + Dim dropdownList As String + Dim key As Variant + For Each key In kenshuList.Keys + If key <> 0 Then + Dim displayText As String + displayText = MakeSelect(key, kenshuList(key)(0)) + If dropdownList = "" Then + dropdownList = displayText + Else + dropdownList = dropdownList & "," & displayText + End If + End If + Next key + + With ws.Range(columnLetter & rowNum).Validation + .Delete + .Add Type:=xlValidateList, Formula1:=dropdownList + .IgnoreBlank = True + .InCellDropdown = True + .InputTitle = "" + .InputMessage = "" + End With +End Sub + +' Create Kenshu dropdown (exclude key = 0) +Public Sub BuildTokubetuDropdown(ws As Worksheet, ByVal columnLetter As String, ByVal rowNum As Long) + Dim tokubetuList As Object: Set tokubetuList = GetCache("tokubetuList") + Dim dropdownList As String: dropdownList = "" + Dim key As Variant + For Each key In tokubetuList.Keys + If dropdownList = "" Then + dropdownList = key + Else + dropdownList = dropdownList & "," & key + End If + Next key + + With ws.Range(columnLetter & rowNum).Validation + .Delete + .Add Type:=xlValidateList, Formula1:=dropdownList + .IgnoreBlank = True + .InCellDropdown = True + .InputTitle = "" + .InputMessage = "" + End With +End Sub \ No newline at end of file diff --git a/src/sh/tuk/sheet/M1.cls b/src/sh/tuk/sheet/M1.cls index 960c3f9..14f7cfd 100644 --- a/src/sh/tuk/sheet/M1.cls +++ b/src/sh/tuk/sheet/M1.cls @@ -7,34 +7,6 @@ ' - Validate ' ============================================================ -' Create dropdown for L column -Private Sub CreateEnumDropdown(ByVal rowNum As Long) - Dim tokubetuList As Object: Set tokubetuList = GetCache("tokubetuList") - ' Build dropdown list from tokubetuList - Dim dropdownList As String - dropdownList = "" - - Dim key As Variant - For Each key In tokubetuList.Keys - If dropdownList = "" Then - dropdownList = key - Else - dropdownList = dropdownList & "," & key - End If - Next key - - With Me.Range("L" & rowNum).Validation - .Delete - .Add Type:=xlValidateList, Formula1:=dropdownList - .IgnoreBlank = True - .InCellDropdown = True - .InputTitle = "" - .InputMessage = "" - End With - -End Sub - -' Private Sub Worksheet_Change(ByVal Target As Range) Dim HasHeaderEdit As Boolean: HasHeaderEdit = CheckHeaderEdit(Me, Target) If HasHeaderEdit = True Then Exit Sub @@ -47,7 +19,7 @@ Private Sub Worksheet_Change(ByVal Target As Range) Me.Cells(cell.Row, 12).Validation.Delete Call ClearDataRow(Me, START_COL + 1, END_COL, cell.Row, ERROR_COL) Else - Call CreateEnumDropdown(cell.Row) + Call BuildTokubetuDropdown(Me, "L", cell.Row) End If Next End If diff --git a/src/sh/tuk/sheet/M2.cls b/src/sh/tuk/sheet/M2.cls index 5567e57..fc5557e 100644 --- a/src/sh/tuk/sheet/M2.cls +++ b/src/sh/tuk/sheet/M2.cls @@ -37,6 +37,7 @@ Private Sub Worksheet_Change(ByVal Target As Range) GoTo Finally Else Call FillFromM1(Me, cell.Row) + Call BuildKenshuDropdown(Me, "I", cell.Row) End If Next End If @@ -45,6 +46,11 @@ Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column = 9 Then Dim cellI As Range For Each cellI In Target + ' Store key only (e.g., "1") in I column + Dim kenshuKey As String: kenshuKey = GetCode(cellI.Value) + If kenshuKey <> "" Then + cellI.Value = kenshuKey + End If ' clear Me.Range(Me.Cells(cellI.Row, 10), Me.Cells(cellI.Row, 18)).ClearContents Me.Cells(cellI.Row, 11).Validation.Delete @@ -61,7 +67,7 @@ Private Sub Worksheet_Change(ByVal Target As Range) Next End If - Dim kenshuKbn As String: kenshuKbn = Trim(Me.Range("I" & Target.Row).value) + Dim kenshuKbn As String: kenshuKbn = Trim(Me.Range("I" & Target.Row).Value) Dim restrictedCols As Range If kenshuKbn = "1" Then Set restrictedCols = Union(Me.Columns("K"), Me.Columns("O"), Me.Columns("P"), Me.Columns("Q"), Me.Columns("R")) @@ -281,15 +287,6 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As End If Next col - ' Check I column in the kenshuKbn - Dim kenshuList As Object: Set kenshuList = GetCache("kenshuList") - Dim kenshuKbn As String: kenshuKbn = Trim(ws.Range("I" & rowNum).Value) - If Not kenshuList.Exists(kenshuKbn) Then - ws.Cells(rowNum, errorCol).Value = GetErrorMsg("E012", "I" & rowNum) - ws.Range("I" & rowNum).Interior.Color = RGB(255, 0, 0) - Exit Sub - End If - ' Check J column in the T1, T2, T3 Dim code As String: code = Trim(ws.Range("J" & rowNum).Value) Dim name As String: name = Trim(ws.Range("K" & rowNum).Value) diff --git a/通勤手当テンプレート20260515.xlsm b/通勤手当テンプレート20260515.xlsm index 3a0e206..d591d8f 100644 Binary files a/通勤手当テンプレート20260515.xlsm and b/通勤手当テンプレート20260515.xlsm differ