diff --git a/src/sh/tuk/module/Common_Button.bas b/src/sh/tuk/module/Common_Button.bas index 33d0991..638645f 100644 --- a/src/sh/tuk/module/Common_Button.bas +++ b/src/sh/tuk/module/Common_Button.bas @@ -411,6 +411,4 @@ End Function Public Sub HandleError(Optional ByVal sourceProcedure As String = "") Dim shortCode As String: shortCode = Right("0000" & CStr(Err.Number - vbObjectError), 4) MsgBox "[ERROR] " & shortCode & " : " & Err.Description, vbExclamation - - End Sub diff --git a/src/sh/tuk/module/Common_Global_Cache.bas b/src/sh/tuk/module/Common_Global_Cache.bas index 0eb82c8..bb3193e 100644 --- a/src/sh/tuk/module/Common_Global_Cache.bas +++ b/src/sh/tuk/module/Common_Global_Cache.bas @@ -596,8 +596,8 @@ Public Sub WriteCachesSheet(ByVal cacheName As String) Case "T1": colLetter = "E" Case "T2": colLetter = "F" Case "T3": colLetter = "G" - Case "O1": colLetter = "H" - Case "O2": colLetter = "I" + Case "O2": colLetter = "H" + Case "M1": colLetter = "I" Case Else: Exit Sub End Select diff --git a/src/sh/tuk/sheet/C1.cls b/src/sh/tuk/sheet/C1.cls index 593f94b..12a740e 100644 --- a/src/sh/tuk/sheet/C1.cls +++ b/src/sh/tuk/sheet/C1.cls @@ -9,7 +9,7 @@ ' - FillKukanFromM1 ' - FillKanshuFromM2 ' - FillCodeFromM2 -' - CreateAddress1Dropdown +' - BuildAddress1Dropdown ' - FillZ1Dropdown ' ============================================================ ' ====== (Tukin_C1) ======= @@ -102,11 +102,10 @@ Private Sub Worksheet_Change(ByVal Target As Range) If Target.Row < 8 Then Exit Sub Dim idx As Long + ' Check if cache is loaded Application.EnableEvents = False On Error GoTo Finally - - ' === 3. rebuild dropdown list === - Call RebuildDropdownsForTarget(Target) + Dim testCache As Object: Set testCache = GetCache("Z1") ' === Column C changes === If Target.Column = 3 Then @@ -116,7 +115,12 @@ Private Sub Worksheet_Change(ByVal Target As Range) If cshainno = "" Then Call ClearRowData(cell.Row) Else - Call CreateAddress1Dropdown(cell.Row, cshainno) + ' rebuild dropdown list + Call BuildAddress1Dropdown(cell.Row, cshainno) + Call ReFillAddress1(cell.Row, cshainno) + Call BuildAddress2Dropdown(cell.Row, cshainno) + Call ReFillAddress2(cell.Row, cshainno) + Call RebuildDropdowns(cell.Row) End If Next End If @@ -141,7 +145,7 @@ Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column = 9 Then Dim cellI As Range For Each cellI In Target - Call CreateAddress2Dropdown(cellI.Row) + Call BuildAddress2Dropdown(cellI.Row, Trim(Me.Cells(cellI.Row, CSHAINNO_COL).Value)) Next End If @@ -228,7 +232,11 @@ Private Sub Worksheet_Change(ByVal Target As Range) Next End If + Application.EnableEvents = True + Exit Sub + Finally: + HandleError "Worksheet_Change" Application.EnableEvents = True ' End Sub @@ -244,53 +252,100 @@ Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean) End If End Sub -Private Sub RebuildDropdownsForTarget(ByVal Target As Range) - If Target Is Nothing Then Exit Sub +Private Sub Refresh(ws As Worksheet, ByVal startRow As Long, ByVal lastDataRow As Long) + Dim z1Cache As Object: Set z1Cache = GetCache("Z1") - Dim cell As Range - Dim processedRows As Object - Set processedRows = CreateObject("Scripting.Dictionary") - - For Each cell In Target - Dim r As Long - r = cell.Row - - If Not processedRows.Exists(r) Then - processedRows(r) = True - - Dim colLetter As String - colLetter = Split(Me.Cells(1, cell.Column).Address(True, False), "$")(0) - - Dim dropdowns As Variant - dropdowns = Array( _ - Array("T", "BuildTransportList"), _ - Array("AA", "BuildTransportList"), _ - Array("AH", "BuildTransportList"), _ - Array("AO", "BuildTransportList"), _ - Array("G", "BuildTodokeList"), _ - Array("M", "BuildOufukuList"), _ - Array("N", "BuildKoutaiList"), _ - Array("AU", "BuildKetteiList"), _ - Array("AW", "BuildHigaitouList"), _ - Array("AX", "BuildMonthAmountKbnList"), _ - Array("BC", "BuildKanshokuList") _ - ) - - Dim i As Long - For i = LBound(dropdowns) To UBound(dropdowns) - If colLetter <> dropdowns(i)(0) Then - With Me.Cells(r, dropdowns(i)(0)).Validation - .Delete - .Add Type:=xlValidateList, Formula1:=Application.Run(dropdowns(i)(1)) - .IgnoreBlank = True - .InCellDropdown = True - End With - End If - Next i - - End If -NextCell: - Next cell + Application.EnableEvents = False + On Error GoTo ErrorHandler + + Dim r As Long + For r = startRow To lastDataRow + Dim cshainno As String: cshainno = Trim(Me.Cells(r, CSHAINNO_COL).Value) + Call BuildAddress1Dropdown(r, cshainno) + Call ReFillAddress1(r, cshainno) + Call BuildAddress2Dropdown(r, cshainno) + Call ReFillAddress2(r, cshainno) + Call RebuildDropdowns(r) + Call ReFillFromDropdowns(r) + Next r + + Application.EnableEvents = True + Exit Sub + +ErrorHandler: + Application.EnableEvents = True + Err.Raise ERR_CACHE_NOT_FOUND, "M1.Refresh", "Failed to refresh M1: " & Err.Description +End Sub + +Private Sub RebuildDropdowns(ByVal rowNum As Long) + Dim dropdowns As Variant + dropdowns = Array( _ + Array("T", "BuildTransportList"), _ + Array("AA", "BuildTransportList"), _ + Array("AH", "BuildTransportList"), _ + Array("AO", "BuildTransportList"), _ + Array("G", "BuildTodokeList"), _ + Array("M", "BuildOufukuList"), _ + Array("N", "BuildKoutaiList"), _ + Array("AU", "BuildKetteiList"), _ + Array("AW", "BuildHigaitouList"), _ + Array("AX", "BuildMonthAmountKbnList"), _ + Array("BC", "BuildKanshokuList") _ + ) + + Dim i As Long + For i = LBound(dropdowns) To UBound(dropdowns) + With Me.Cells(rowNum, dropdowns(i)(0)).Validation + .Delete + .Add Type:=xlValidateList, Formula1:=Application.Run(dropdowns(i)(1)) + .IgnoreBlank = True + .InCellDropdown = True + End With + Next i +End Sub + +Private Sub ReFillFromDropdowns(ByVal rowNum As Long) + Dim dropdowns As Variant + dropdowns = Array( _ + Array("T", "BuildTransportList"), _ + Array("AA", "BuildTransportList"), _ + Array("AH", "BuildTransportList"), _ + Array("AO", "BuildTransportList"), _ + Array("G", "BuildTodokeList"), _ + Array("M", "BuildOufukuList"), _ + Array("N", "BuildKoutaiList"), _ + Array("AU", "BuildKetteiList"), _ + Array("AW", "BuildHigaitouList"), _ + Array("AX", "BuildMonthAmountKbnList"), _ + Array("BC", "BuildKanshokuList") _ + ) + + Dim i As Long + For i = LBound(dropdowns) To UBound(dropdowns) + Dim col As String: col = dropdowns(i)(0) + Dim funcName As String: funcName = dropdowns(i)(1) + Dim cellValue As String: cellValue = Trim(Me.Cells(rowNum, col).Value) + If cellValue = "" Then GoTo NextDropdown + + Dim key As String: key = GetCode(cellValue) + If InStr(cellValue, ":") = 0 Then GoTo NextDropdown ' Skip if not key:value format + + ' Get dropdown list + Dim dropdownList As String: dropdownList = Application.Run(funcName) + Dim items As Variant: items = Split(dropdownList, ",") + + ' Check if key exists in dropdown + Dim j As Long + For j = LBound(items) To UBound(items) + Dim item As String: item = Trim(items(j)) + If GetCode(item) = key Then + ' Found matching key, update with full key:value + Me.Cells(rowNum, col).Value = item + Exit For + End If + Next j +NextDropdown: + Next i End Sub ' Fill kukan info from M1 cache (key: kukan code, value: 7 elements) @@ -331,12 +386,8 @@ End Sub ' triggered by c clomun cshainno input ' when cshainno does not exist in o1, clear dropdownList and value ' when cshainno exist in o1, create dropdownList and value -Private Sub CreateAddress1Dropdown(ByVal rowNum As Long, ByVal cshainno As String) +Private Sub BuildAddress1Dropdown(ByVal rowNum As Long, ByVal cshainno As String) Dim o1Cache As Object: Set o1Cache = GetCache("O1") - Me.Range("I" & rowNum).Validation.Delete - Me.Range("I" & rowNum).Value = "" - Me.Range("J" & rowNum).Validation.Delete - Me.Range("J" & rowNum).Value = "" ' Build dropdown list from O1 cache: get all E values for the C Dim dropdownList As String If o1Cache.Exists(cshainno) Then @@ -365,14 +416,35 @@ Private Sub CreateAddress1Dropdown(ByVal rowNum As Long, ByVal cshainno As Strin End If End Sub +Private Sub ReFillAddress1(ByVal rowNum As Long, ByVal cshainno As String) + Dim o1Cache As Object: Set o1Cache = GetCache("O1") + If Not o1Cache.Exists(cshainno) Then + Me.Cells(rowNum, ADDRESS1_COL).Value = "" + Exit Sub + End If + + Dim innerDict As Object: Set innerDict = o1Cache(cshainno) + If innerDict.Count = 1 Then + ' Auto-fill if only one key exists + Dim keys As Variant: keys = innerDict.Keys + Me.Cells(rowNum, ADDRESS1_COL).Value = keys(0) + Exit Sub + End If + + Dim originalValue As String: originalValue = Trim(Me.Cells(rowNum, ADDRESS1_COL).Value) + If originalValue = "" Then Exit Sub + + ' Clear if value not found in O1 cache keys + If Not innerDict.Exists(originalValue) Then + Me.Cells(rowNum, ADDRESS1_COL).Value = "" + End If +End Sub + ' triggered by address1 select O1 cache -Private Sub CreateAddress2Dropdown(ByVal rowNum As Long) +Private Sub BuildAddress2Dropdown(ByVal rowNum As Long, ByVal cshainno As String) ' Clear address2 contents - Me.Range(ADDRESS2_COL & rowNum).Validation.Delete - Me.Range(ADDRESS2_COL & rowNum).Value = "" ' obtain cshainno, address1, o1Cache Dim o1Cache As Object: Set o1Cache = GetCache("O1") - Dim cshainno As String: cshainno = Trim(Me.Cells(rowNum, CSHAINNO_COL).Value) Dim address1 As String: address1 = Trim(Me.Cells(rowNum, ADDRESS1_COL).Value) If cshainno = "" OR address1 = "" Then Exit Sub @@ -412,6 +484,35 @@ Private Sub CreateAddress2Dropdown(ByVal rowNum As Long) End If End Sub +Private Sub ReFillAddress2(ByVal rowNum As Long, ByVal cshainno As String) + Dim address1 As String: address1 = Trim(Me.Cells(rowNum, ADDRESS1_COL).Value) + If address1 = "" Then + Me.Cells(rowNum, ADDRESS2_COL).Value = "" + Exit Sub + End If + + Dim o1Cache As Object: Set o1Cache = GetCache("O1") + If Not o1Cache.Exists(cshainno) Then + Me.Cells(rowNum, ADDRESS2_COL).Value = "" + Exit Sub + End If + + Dim innerDict As Object: Set innerDict = o1Cache(cshainno) + If Not innerDict.Exists(address1) Then + Me.Cells(rowNum, ADDRESS2_COL).Value = "" + Exit Sub + End If + + Dim addr2Dict As Object: Set addr2Dict = innerDict(address1) + If addr2Dict.Count = 1 Then + Dim keys As Variant: keys = addr2Dict.Keys + Me.Cells(rowNum, ADDRESS2_COL).Value = keys(0) + Exit Sub + End If + + Me.Cells(rowNum, ADDRESS2_COL).Value = "" +End Sub + ' Create station from dropdown from M1_KukanD cache Private Sub CreateFromStationDropdown(ByVal rowNum As Long, ByVal transportCol As Long, ByVal stationCol As Long) Dim m1KukanDCache As Object: Set m1KukanDCache = GetCache("M1KukanDCache") diff --git a/src/sh/tuk/sheet/M2.cls b/src/sh/tuk/sheet/M2.cls index 1a0e85c..dff9ca6 100644 --- a/src/sh/tuk/sheet/M2.cls +++ b/src/sh/tuk/sheet/M2.cls @@ -230,15 +230,33 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As Next emptyCol ' check Duplicate - Dim i As Long - For i = 7 To rowNum - 1 - If Trim(ws.Cells(i, "C").Value) = cValue And Trim(ws.Cells(i, "I").Value) = kenshuKbn And Trim(ws.Cells(i, "J").Value) = code Then - errorCell.Value = GetErrorMsg("E013", i, code) + Dim sikyuKikan As String: sikyuKikan = Trim(ws.Range("N" & rowNum).Value) + Dim hasError As Boolean: hasError = False + Dim otherValueC As String, otherValueI As String, otherValueJ As String, otherValueN As String + Dim otherRow As Long + For otherRow = 7 To rowNum - 1 + otherValueC = Trim(ws.Cells(otherRow, "C").Value) + otherValueI = Trim(ws.Cells(otherRow, "I").Value) + otherValueJ = Trim(ws.Cells(otherRow, "J").Value) + otherValueN = Trim(ws.Cells(otherRow, "N").Value) + If kenshuKbn = "1" Then + If otherValueC = cValue And otherValueI = kenshuKbn And otherValueJ = code And otherValueN = sikyuKikan Then + hasError = True + End If + Else + If otherValueC = cValue And otherValueI = kenshuKbn And otherValueJ = code Then + hasError = True + End If + End If + + If hasError = True Then + errorCell.Value = GetErrorMsg("E013", otherRow, code) ws.Cells(rowNum, "C").Interior.Color = RGB(255, 0, 0) Exit Sub End If - Next i + Next otherRow + ' validate passed, clear error cell and setup backcolor errorCell.ClearContents Application.EnableEvents = False Call ChangeBackColor(rowNum) diff --git a/通勤手当テンプレート20260515.xlsm b/通勤手当テンプレート20260515.xlsm index 5282ef6..e755770 100644 Binary files a/通勤手当テンプレート20260515.xlsm and b/通勤手当テンプレート20260515.xlsm differ