20260515指摘対応5
This commit is contained in:
guanxiangwei
@@ -9,7 +9,7 @@ Option Explicit
|
||||
' - RefreshO1Cache
|
||||
' ============================================================
|
||||
Private sheetConfDict As Object
|
||||
|
||||
Private FormulaCache As Object
|
||||
Public GlobalCache As Object
|
||||
|
||||
Public Sub InitCacheManager()
|
||||
@@ -20,65 +20,33 @@ Public Sub InitCacheManager()
|
||||
End Sub
|
||||
|
||||
Public Function GetCache(ByVal cacheName As String) As Object
|
||||
Dim cache As Object
|
||||
Dim loadedData As Object
|
||||
|
||||
'
|
||||
On Error GoTo RefreshError
|
||||
|
||||
'
|
||||
If GlobalCache Is Nothing Then InitCacheManager
|
||||
|
||||
'
|
||||
If Not GlobalCache.Exists(cacheName) Then
|
||||
Set GlobalCache(cacheName) = CreateObject("Scripting.Dictionary")
|
||||
GlobalCache(cacheName).CompareMode = vbTextCompare
|
||||
End If
|
||||
|
||||
Dim cache As Object
|
||||
Set cache = GlobalCache(cacheName)
|
||||
Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
|
||||
If cache.Count = 0 Then
|
||||
If cacheName = "M1KukanDCache" Then
|
||||
Set loadedData = LookupM1KukanCache()
|
||||
ElseIf cacheName = "M2" Then
|
||||
Set loadedData = LookupM2Cache()
|
||||
ElseIf cacheName = "O1" Then
|
||||
Set loadedData = LookupO1Cache()
|
||||
ElseIf Contains(sheetConfDict("Enum"), cacheName) Then
|
||||
Set loadedData = LoadLookup("Enum", cacheName)
|
||||
Else
|
||||
Set loadedData = LoadLookup(cacheName, cacheName)
|
||||
End If
|
||||
|
||||
If Not loadedData Is Nothing Then
|
||||
Set GlobalCache(cacheName) = loadedData
|
||||
Set cache = loadedData
|
||||
End If
|
||||
Err.Raise 1001, "GetCache", "No cached data found for '" & cacheName & "'. Please load the cache first."
|
||||
End If
|
||||
|
||||
Set GetCache = cache
|
||||
Exit Function
|
||||
|
||||
RefreshError:
|
||||
Err.Raise 1001, "GetCache", "Failed to load " & cacheName & " lookup cache: " & Err.Description
|
||||
End Function
|
||||
|
||||
' before RefreshCache, should validate
|
||||
Public Sub RefreshCache(ByVal cacheName As String)
|
||||
Dim loadedData As Object
|
||||
|
||||
'
|
||||
On Error GoTo RefreshError
|
||||
|
||||
'
|
||||
If GlobalCache Is Nothing Then InitCacheManager
|
||||
|
||||
'
|
||||
If Not GlobalCache.Exists(cacheName) Then
|
||||
Set GlobalCache(cacheName) = CreateObject("Scripting.Dictionary")
|
||||
GlobalCache(cacheName).CompareMode = vbTextCompare
|
||||
End If
|
||||
|
||||
Dim loadedData As Object
|
||||
Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
|
||||
If cacheName = "M1KukanDCache" Then
|
||||
Set loadedData = LookupM1KukanCache()
|
||||
@@ -573,6 +541,12 @@ Private Sub RefreshSheetDict()
|
||||
Set sheetConfDict("errorList") = sheetConf
|
||||
Debug.Print "RefreshSheetDict errorList ok."
|
||||
|
||||
' Caches
|
||||
Set sheetConf = CreateObject("Scripting.Dictionary")
|
||||
' TODO
|
||||
Set sheetConfDict("Caches") = sheetConf
|
||||
Debug.Print "RefreshSheetDict Caches ok."
|
||||
|
||||
Debug.Print "RefreshSheetDict end."
|
||||
End Sub
|
||||
|
||||
@@ -581,32 +555,93 @@ Public Function GetSheetConfig() As Object
|
||||
Set GetSheetConfig = sheetConfDict
|
||||
End Function
|
||||
|
||||
Public Function RefreshAllCache(Optional ByVal activeSheetName As String = "") As Boolean
|
||||
Public Sub RefreshMasterCache()
|
||||
' Fixed cache names
|
||||
Dim fixedCaches As Variant
|
||||
fixedCaches = Array("Z1", "Z2", "Z3", "Z4", "T1", "T2", "T3", "O1", "O2", _
|
||||
"tokubetuList", "kenshuList", "renrakuList", "oufukuList", "koutaiList", "higaitouList", "errorList")
|
||||
|
||||
' Dynamic cache names based on activeSheet
|
||||
Dim dynamicCaches As Variant
|
||||
If activeSheetName = "C1" Then
|
||||
dynamicCaches = Array("M1", "M1KukanDCache", "M2")
|
||||
ElseIf activeSheetName = "M2" Then
|
||||
dynamicCaches = Array("M1", "M1KukanDCache")
|
||||
Else
|
||||
dynamicCaches = Array()
|
||||
End If
|
||||
|
||||
' Refresh fixed caches
|
||||
Dim cacheName As Variant
|
||||
For Each cacheName In fixedCaches
|
||||
Call RefreshCache(CStr(cacheName))
|
||||
Call WriteCachesSheet(CStr(cacheName))
|
||||
Next cacheName
|
||||
End Sub
|
||||
|
||||
Public Sub RefreshKukanCache(ByVal sheetName As String)
|
||||
If sheetName = "M1" Then
|
||||
Call RefreshCache("M1")
|
||||
Call RefreshCache("M1KukanDCache")
|
||||
Call WriteCachesSheet("M1")
|
||||
End If
|
||||
If sheetName = "M2" Then
|
||||
Call RefreshCache("M2")
|
||||
Call WriteCachesSheet("M2")
|
||||
End If
|
||||
End Sub
|
||||
|
||||
' Write cache data to Caches sheet for dropdown
|
||||
Public Sub WriteCachesSheet(ByVal cacheName 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
|
||||
|
||||
' Refresh dynamic caches
|
||||
For Each cacheName In dynamicCaches
|
||||
Call RefreshCache(CStr(cacheName))
|
||||
Next cacheName
|
||||
' Map cacheName to column letter
|
||||
Dim colLetter As String
|
||||
Select Case cacheName
|
||||
Case "Z1": colLetter = "A"
|
||||
Case "Z2": colLetter = "B"
|
||||
Case "Z3": colLetter = "C"
|
||||
Case "Z4": colLetter = "D"
|
||||
Case "T1": colLetter = "E"
|
||||
Case "T2": colLetter = "F"
|
||||
Case "T3": colLetter = "G"
|
||||
Case "O1": colLetter = "H"
|
||||
Case "O2": colLetter = "I"
|
||||
Case Else: Exit Sub
|
||||
End Select
|
||||
|
||||
RefreshAllCache = True
|
||||
End Function
|
||||
Dim cache As Object: Set cache = GetCache(cacheName)
|
||||
If cache Is Nothing Then Exit Sub
|
||||
|
||||
' Write to Caches sheet
|
||||
wsCache.Columns(colLetter).ClearContents
|
||||
Dim idx As Long: idx = 1
|
||||
Dim key As Variant
|
||||
For Each key In cache.Keys
|
||||
If key <> 0 Then
|
||||
Dim displayText As String: displayText = MakeSelect(key, cache(key)(0))
|
||||
If displayText <> "" Then
|
||||
wsCache.Cells(idx, colLetter).Value = displayText
|
||||
idx = idx + 1
|
||||
End If
|
||||
End If
|
||||
Next key
|
||||
|
||||
Dim lastRow As Long: lastRow = wsCache.Cells(wsCache.Rows.Count, colLetter).End(xlUp).Row
|
||||
|
||||
Dim formulaStr As String
|
||||
If lastRow >= 1 Then
|
||||
formulaStr = "=Caches!" & colLetter & "1:" & colLetter & lastRow
|
||||
Else
|
||||
formulaStr = "=Caches!" & colLetter & "1"
|
||||
End If
|
||||
|
||||
' write into FormulaCache
|
||||
If FormulaCache Is Nothing Then Set FormulaCache = CreateObject("Scripting.Dictionary")
|
||||
FormulaCache(cacheName) = formulaStr
|
||||
End Sub
|
||||
|
||||
Public Function GetValidationFormula(ByVal cacheName As String) As String
|
||||
If FormulaCache Is Nothing Then Set FormulaCache = CreateObject("Scripting.Dictionary")
|
||||
If FormulaCache.Exists(cacheName) Then
|
||||
GetValidationFormula = FormulaCache(cacheName)
|
||||
Else
|
||||
GetValidationFormula = ""
|
||||
End If
|
||||
End Function
|
||||
|
||||
Reference in New Issue
Block a user