UPDSV7-1081 【製造】諸手当一括取込　追加対応　通勤定期券対応

2026-06-22 12:40:29 +09:00
parent 688ca30ca9
commit c31130519c
6 changed files with 258 additions and 67 deletions
@@ -21,6 +21,7 @@ Public Const CACHE_O2 As String = "O2"
 Public Const CACHE_O3 As String = "O3"
 Public Const CACHE_M1 As String = "M1"
 Public Const CACHE_M2 As String = "M2"
+Private Const O1_BLOCK_SIZE As Long = 100


 Private sheetConfDict As Object
@@ -751,6 +752,101 @@ Public Sub WriteCachesSheet(ByVal cacheName As String)
    FormulaCache(cacheName) = formulaStr
 End Sub

+' ============================================================
+' O1 Address Dropdown Cache Writers
+' Per-row address1/address2 unique values are written to Caches sheet
+' so xlValidateList Formula1 references Text-formatted cells.
+' This bypasses Excel's date/number auto-coercion that happens when
+' comma-separated Formula1 strings contain values like "2623-41".
+'
+' Layout:
+'   Caches column N (14) = O1 address1 data
+'   Caches column O (15) = O1 address2 data
+'   Block per C1 row: rows (rowNum-1)*O1_BLOCK_SIZE+1 to rowNum*O1_BLOCK_SIZE
+' ============================================================
+
+' Write O1 address1 unique values for cshainno into Caches col N block.
+' Returns Formula1 like "=Caches!$N$X:$N$Y", or "" if no data.
+Public Function WriteCachesSheetForO1Address1(ByVal cshainno As String, ByVal rowNum As Long) As String
+    Dim wsCache As Worksheet
+    Set wsCache = ThisWorkbook.Sheets("Caches")
+    If wsCache Is Nothing Then
+        Set wsCache = ThisWorkbook.Sheets.Add
+        wsCache.Name = "Caches"
+        wsCache.Visible = xlVeryHidden
+    End If
+
+    Const COL As Long = 14  ' N column
+    Dim blockStart As Long: blockStart = (rowNum - 1) * O1_BLOCK_SIZE + 1
+    Dim blockEnd As Long: blockEnd = blockStart + O1_BLOCK_SIZE - 1
+
+    ' Clear block to prevent stale data leakage across rows
+    wsCache.Range(wsCache.Cells(blockStart, COL), wsCache.Cells(blockEnd, COL)).ClearContents
+
+    Dim o1Cache As Object: Set o1Cache = GetCache(CACHE_O1)
+    If o1Cache Is Nothing Then Exit Function
+    If Not o1Cache.Exists(cshainno) Then Exit Function
+
+    Dim innerDict As Object: Set innerDict = o1Cache(cshainno)
+
+    Dim idx As Long: idx = 0
+    Dim eKey As Variant
+    For Each eKey In innerDict.Keys
+        idx = idx + 1
+        With wsCache.Cells(blockStart + idx, COL)
+            .NumberFormat = "@"
+            .Value = CStr(eKey)
+        End With
+        If idx >= O1_BLOCK_SIZE Then Exit For
+    Next eKey
+
+    If idx = 0 Then Exit Function
+
+    WriteCachesSheetForO1Address1 = "=Caches!$N$" & (blockStart + 1) & ":$N$" & (blockStart + idx)
+End Function
+
+' Write O1 address2 unique values for (cshainno, address1) into Caches col O block.
+' Returns Formula1 like "=Caches!$O$X:$O$Y", or "" if no data.
+Public Function WriteCachesSheetForO1Address2(ByVal cshainno As String, ByVal address1 As String, ByVal rowNum As Long) As String
+    Dim wsCache As Worksheet
+    Set wsCache = ThisWorkbook.Sheets("Caches")
+    If wsCache Is Nothing Then
+        Set wsCache = ThisWorkbook.Sheets.Add
+        wsCache.Name = "Caches"
+        wsCache.Visible = xlVeryHidden
+    End If
+
+    Const COL As Long = 15  ' O column
+    Dim blockStart As Long: blockStart = (rowNum - 1) * O1_BLOCK_SIZE + 1
+    Dim blockEnd As Long: blockEnd = blockStart + O1_BLOCK_SIZE - 1
+
+    wsCache.Range(wsCache.Cells(blockStart, COL), wsCache.Cells(blockEnd, COL)).ClearContents
+
+    Dim o1Cache As Object: Set o1Cache = GetCache(CACHE_O1)
+    If o1Cache Is Nothing Then Exit Function
+    If Not o1Cache.Exists(cshainno) Then Exit Function
+
+    Dim innerDict As Object: Set innerDict = o1Cache(cshainno)
+    If Not innerDict.Exists(address1) Then Exit Function
+
+    Dim addr2Dict As Object: Set addr2Dict = innerDict(address1)
+
+    Dim idx As Long: idx = 0
+    Dim addr2Key As Variant
+    For Each addr2Key In addr2Dict.Keys
+        idx = idx + 1
+        With wsCache.Cells(blockStart + idx, COL)
+            .NumberFormat = "@"
+            .Value = CStr(addr2Key)
+        End With
+        If idx >= O1_BLOCK_SIZE Then Exit For
+    Next addr2Key
+
+    If idx = 0 Then Exit Function
+
+    WriteCachesSheetForO1Address2 = "=Caches!$O$" & (blockStart + 1) & ":$O$" & (blockStart + idx)
+End Function
+
 Public Function GetValidationFormula(ByVal cacheName As String) As String
    If FormulaCache Is Nothing Then Set FormulaCache = CreateObject("Scripting.Dictionary")
    If FormulaCache.Exists(cacheName) Then