add reload cache button

This commit is contained in:
updsv7
2026-04-20 19:00:59 +09:00
parent 5c40eb4381
commit 1b851b2224
4 changed files with 34 additions and 5 deletions

View File

@@ -31,7 +31,10 @@ Sub Fit_Button()
End Sub
Sub RefreshCache_Button()
' 重新加载所有缓存
Dim result As Boolean: result = RefreshCache()
If result = True Then
MsgBox "master data reload successfully."
End If
End Sub
Private Sub DO_CSV_Import(ws As Excel.Worksheet)
@@ -205,7 +208,7 @@ ExportError:
End Sub
Private Sub Do_Sort(ws As Excel.Worksheet)
MsgBox "1"
'
End Sub
Private Sub Do_Filter(ws As Excel.Worksheet)

View File

@@ -249,10 +249,10 @@ Private Sub RefreshO1Cache()
Dim lastRow As Long
lastRow = wsO1.Cells(wsO1.Rows.Count, 3).End(xlUp).Row
If lastRow < 7 Then Exit Sub
If lastRow < 6 Then Exit Sub
Dim r As Long
For r = 7 To lastRow
For r = 6 To lastRow
Dim cVal As String
cVal = Trim(wsO1.Cells(r, 3).Value) ' C column
Dim eVal As String
@@ -293,7 +293,7 @@ Private Sub RefreshO2Cache()
Set o2Cache = Nothing
On Error GoTo RefreshError
Set o2Cache = LoadLookup("O2", keyCol:=3, valueCols:=Array(4), startRow:=7)
Set o2Cache = LoadLookup("O2", keyCol:=3, valueCols:=Array(4), startRow:=6)
On Error GoTo 0
If o2Cache Is Nothing Or o2Cache.Count = 0 Then
@@ -636,4 +636,22 @@ End Function
Public Function GetKenshuList() As Object
If kenshuList Is Nothing Then Call RefreshKenshuList
Set GetKenshuList = kenshuList
End Function
Public Function RefreshCache() As Boolean
Call RefreshM1Cache
Call RefreshM1KukanDCache
Call RefreshM2Cache
Call RefreshZ1Cache
Call RefreshZ2Cache
Call RefreshZ3Cache
Call RefreshZ4Cache
Call RefreshO1Cache
Call RefreshO2Cache
Call RefreshTokubetu
Call RefreshOufukuList
Call RefreshKoutaiList
Call RefreshHigaitouList
Call RefreshKenshuList
RefreshCache = True
End Function

View File

@@ -152,6 +152,14 @@ Private Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
Exit Sub
End If
' Check if M2 uses this M1 kukan code
Dim m2Cache As Object: Set m2Cache = GetM2Cache()
If Not m2Cache.Exists(cValue) Then
ws.Cells(rowNum, errorCol).Value = "The section details are not registered for the corresponding section"
ws.Range("C" & rowNum).Interior.Color = RGB(255, 128, 0)
Exit Sub
End If
' Validation passed - clear error
ws.Cells(rowNum, errorCol).ClearContents
End Sub