20260515指摘対応10

2026-05-22 12:01:40 +09:00
parent 56ca7ed8c5
commit 81a8060448
5 changed files with 187 additions and 70 deletions
--- 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
--- 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
    
--- 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")
--- 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)
--- a/通勤手当テンプレート20260515.xlsm
+++ b/通勤手当テンプレート20260515.xlsm