20260515指摘対応10

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

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
     

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")
+    Application.EnableEvents = False
+    On Error GoTo ErrorHandler
 
-    For Each cell In Target
-        Dim r As Long
-        r = cell.Row
+    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
 
-        If Not processedRows.Exists(r) Then
-            processedRows(r) = True
+    Application.EnableEvents = True
+    Exit Sub
 
-            Dim colLetter As String
-            colLetter = Split(Me.Cells(1, cell.Column).Address(True, False), "$")(0)
+ErrorHandler:
+    Application.EnableEvents = True
+    Err.Raise ERR_CACHE_NOT_FOUND, "M1.Refresh", "Failed to refresh M1: " & Err.Description
+End Sub
 
-            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") _
-            )
+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)
-                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
+    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
 
-        End If
-NextCell:
-    Next cell
+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")

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)