update glogle cache

This commit is contained in:
updsv7
2026-04-17 17:42:18 +09:00
parent f967c165c0
commit dd874cf811
5 changed files with 240 additions and 49 deletions

View File

@@ -29,9 +29,8 @@ Sub Generic_Master_Import(ByVal ws As Worksheet, ByVal expectedColumnCount As Lo
Dim colOffset As Long
For colOffset = 1 To expectedColumnCount
ws.Cells(writeRow, 2 + colOffset).Value = CleanCSVField(CStr(lines(i, colOffset)))
writeRow = writeRow + 1
Next colOffset
writeRow = writeRow + 1
End If
Next i

View File

@@ -18,9 +18,14 @@ Public m1KukanDCache As Object
Public z1Cache As Object
Public z2Cache As Object
Public z3Cache As Object
Public z4Cache As Object
Public o1Cache As Object
Public o2Cache As Object
Public m2Cache As Object
Public tokubetuList As Object
Public oufukuList As Object
Public koutaiList As Object
Public higaitouList As Object
' m1Cache - used by M2_Kukan_detail, Tukin_C1
' m1KukanDCache - nested dict {D: {F: [G]}}
@@ -229,6 +234,28 @@ Public Sub ClearZ3Cache()
Set z3Cache = Nothing
End Sub
' ============================================================
' z4Cache
' ============================================================
Public Sub RefreshZ4Cache()
On Error GoTo RefreshError
Set z4Cache = LoadLookup("Z4", keyCol:=3, valueCols:=Array(4), startRow:=7)
On Error GoTo 0
If z4Cache Is Nothing Or z4Cache.Count = 0 Then
Err.Raise 1003, "RefreshZ4Cache", "Enum reference data is empty"
End If
Exit Sub
RefreshError:
Err.Raise 1001, "RefreshZ4Cache", "Failed to load Enum lookup cache: " & Err.Description
End Sub
Public Sub ClearZ4Cache()
Set z4Cache = Nothing
End Sub
' ============================================================
' O1 Cache
' ============================================================
@@ -312,8 +339,6 @@ End Sub
' ============================================================
' tokubetuList
' ============================================================
Public tokubetuList As Object
Public Sub GetTokubetu()
On Error GoTo RefreshError
Set tokubetuList = LoadLookup("Enum", keyCol:=1, valueCols:=Array(1), startRow:=3)
@@ -333,38 +358,12 @@ Public Sub ClearTokubetu()
Set tokubetuList = Nothing
End Sub
' ============================================================
' todokeList
' ============================================================
Public todokeList As Object
Public Sub GetTodokeList()
On Error GoTo RefreshError
Set todokeList = LoadLookup("Enum", keyCol:=6, valueCols:=Array(7), startRow:=3)
On Error GoTo 0
If todokeList Is Nothing Or todokeList.Count = 0 Then
Err.Raise 1003, "GetTodokeList", "Enum reference data is empty"
End If
Exit Sub
RefreshError:
Err.Raise 1001, "GetTodokeList", "Failed to load Enum lookup cache: " & Err.Description
End Sub
Public Sub ClearTodokeList()
Set todokeList = Nothing
End Sub
' ============================================================
' oufukuList
' ============================================================
Public oufukuList As Object
Public Sub GetOufukuList()
On Error GoTo RefreshError
Set oufukuList = LoadLookup("Enum", keyCol:=9, valueCols:=Array(10), startRow:=3)
Set oufukuList = LoadLookup("Enum", keyCol:=6, valueCols:=Array(7), startRow:=3)
On Error GoTo 0
If oufukuList Is Nothing Or oufukuList.Count = 0 Then
@@ -384,11 +383,9 @@ End Sub
' ============================================================
' koutaiList
' ============================================================
Public koutaiList As Object
Public Sub GetKoutaiList()
On Error GoTo RefreshError
Set koutaiList = LoadLookup("Enum", keyCol:=12, valueCols:=Array(13), startRow:=3)
Set koutaiList = LoadLookup("Enum", keyCol:=9, valueCols:=Array(10), startRow:=3)
On Error GoTo 0
If koutaiList Is Nothing Or koutaiList.Count = 0 Then
@@ -404,3 +401,25 @@ End Sub
Public Sub ClearKoutaiList()
Set koutaiList = Nothing
End Sub
' ============================================================
' higaitouList
' ============================================================
Public Sub GetHigaitouList()
On Error GoTo RefreshError
Set higaitouList = LoadLookup("Enum", keyCol:=12, valueCols:=Array(13), startRow:=3)
On Error GoTo 0
If higaitouList Is Nothing Or higaitouList.Count = 0 Then
Err.Raise 1003, "GetHigaitouList", "Enum reference data is empty"
End If
Exit Sub
RefreshError:
Err.Raise 1001, "GetHigaitouList", "Failed to load Enum lookup cache: " & Err.Description
End Sub
Public Sub ClearHigaitouList()
Set higaitouList = Nothing
End Sub

View File

@@ -0,0 +1,173 @@
' ============================================================
' Module Name: Master_Z4_220
' Module Desc: Z4 master data management (220)
' Module Methods:
' - Z4_Import
' - Z4_Export
' - Z4_SortDataRowsByC
' - Z4_ToggleAutoFilter
' ============================================================
' ====== (220) =======
' ====== Constants ======
Const START_COL As Long = 3
Const END_COL As Long = 9
Const ERROR_COL As Long = 2
' ====== Function ======
Sub Z4_Import()
Call Generic_Master_Import(Me, 7)
End Sub
Sub Z4_Export()
Dim lastDataRow As Long: lastDataRow = GetLastDataRowInRange(Me, START_COL, END_COL)
If lastDataRow < 7 Then
MsgBox "No data rows to output.", vbExclamation
Exit Sub
End If
Dim r As Long, errorCount As Long
For r = 7 To lastDataRow
Validate r
If Trim(Cells(r, 2).Value & "") <> "" Then
errorCount = errorCount + 1
End If
Next r
If errorCount > 0 Then
MsgBox "Validation failed. Found " & errorCount & " error(s). Please correct them before exporting.", vbCritical
Exit Sub
End If
Call Generic_Master_Export(Me, 7, lastDataRow)
End Sub
Sub Validate(ByVal rowNum As Long)
Set ws = Me
Dim cValue As String: cValue = Trim(ws.Cells(rowNum, 3).Value)
' clear C~I columns background color
Dim clearRange As Range
Set clearRange = ws.Range(ws.Cells(rowNum, START_COL), ws.Cells(rowNum, END_COL))
clearRange.Interior.Color = vbWhite
If cValue = "" Then
ws.Cells(rowNum, 2).Value = "C column is required"
ws.Cells(rowNum, 3).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
If Len(cValue) <> 3 Then
ws.Cells(rowNum, 2).Value = "C column must be 3 characters"
ws.Cells(rowNum, 3).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
Dim i As Long
Dim ch As String
For i = 1 To 3
ch = Mid(cValue, i, 1)
If Not ((ch >= "0" And ch <= "9") Or (ch >= "A" And ch <= "Z") Or (ch >= "a" And ch <= "z")) Then
ws.Cells(rowNum, 2).Value = "C column must be alphanumeric"
ws.Cells(rowNum, 3).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
Next i
Dim dValue As String
dValue = Trim(ws.Cells(rowNum, 4).Value)
If dValue = "" Then
ws.Cells(rowNum, 2).Value = "D column is required"
ws.Cells(rowNum, 4).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
If Len(dValue) > 80 Then
ws.Cells(rowNum, 2).Value = "D column must be within 80 characters"
ws.Cells(rowNum, 4).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
Dim eValue As String
eValue = Trim(ws.Cells(rowNum, 5).Value)
If eValue = "" Then
ws.Cells(rowNum, 2).Value = "E column is required"
ws.Cells(rowNum, 5).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
If Len(eValue) > 80 Then
ws.Cells(rowNum, 2).Value = "E column must be within 80 characters"
ws.Cells(rowNum, 5).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
Dim fValue As String
fValue = Trim(ws.Cells(rowNum, 6).Value)
If fValue <> "" And Len(fValue) > 80 Then
ws.Cells(rowNum, 2).Value = "F column must be within 80 characters"
ws.Cells(rowNum, 6).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
Dim hValue As String
hValue = Trim(ws.Cells(rowNum, 7).Value)
If hValue <> "" Then
If Len(hValue) <> 1 Then
ws.Cells(rowNum, 2).Value = "G column must be 1 digit"
ws.Cells(rowNum, 7).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
If hValue <> "0" And hValue <> "1" Then
ws.Cells(rowNum, 2).Value = "G column must be 0 or 1"
ws.Cells(rowNum, 7).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
End If
Dim iValue As String
iValue = Trim(ws.Cells(rowNum, 8).Value)
If iValue <> "" And Len(iValue) > 80 Then
ws.Cells(rowNum, 2).Value = "H column must be within 80 characters"
ws.Cells(rowNum, 8).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
ws.Cells(rowNum, 2).ClearContents
End Sub
Sub Z4_validateButton()
Dim lastDataRow As Long, r As Long, errorCount As Long
lastDataRow = GetLastDataRowInRange(Me, START_COL, END_COL)
If lastDataRow < 7 Then
MsgBox "No data found.", vbExclamation
Exit Sub
End If
errorCount = 0
For r = 7 To lastDataRow
Validate r
If Trim(Cells(r, ERROR_COL).Value) <> "" Then
errorCount = errorCount + 1
End If
Next r
' === Refresh Z4 cache after validation passes ===
If errorCount = 0 Then
Call RefreshZ4Cache
End If
MsgBox "Validation complete. Errors: " & errorCount, vbInformation
End Sub
Sub Z4_SortDataRowsByC()
Call SortDataRows(3)
End Sub
Sub Z4_ToggleAutoFilter()
Call ToggleAutoFilter(2, END_COL)
End Sub
Sub Z4_AutoFitColumnWidth()
Call AutoFitColumnWidth(2, END_COL)
End Sub

View File

@@ -357,13 +357,13 @@ End Function
' Create todoke (G) dropdown
Private Function BuildTodokeList()
If todokeList Is Nothing Then Call GetTodokeList
If z4Cache Is Nothing Then Call RefreshZ4Cache
Dim dropdownList As String
Dim key As Variant
For Each key In todokeList.Keys
For Each key In z4Cache.Keys
Dim displayText As String
displayText = MakeSelect(key, todokeList(key)(0))
displayText = MakeSelect(key, z4Cache(key)(0))
If dropdownList = "" Then
dropdownList = displayText
Else
@@ -411,13 +411,13 @@ End Function
' Create Kettei (AU) dropdown
Private Function BuildKetteiList()
If z1Cache Is Nothing Then Call RefreshZ1Cache
If z2Cache Is Nothing Then Call RefreshZ2Cache
Dim dropdownList As String
Dim key As Variant
For Each key In z1Cache.Keys
For Each key In z2Cache.Keys
Dim displayText As String
displayText = MakeSelect(key, z1Cache(key)(0))
displayText = MakeSelect(key, z2Cache(key)(0))
If dropdownList = "" Then
dropdownList = displayText
Else
@@ -429,13 +429,13 @@ End Function
' Create Higaitou (AW) dropdown
Private Function BuildHigaitouList()
If z1Cache Is Nothing Then Call RefreshZ1Cache
If higaitouList Is Nothing Then Call GetHigaitouList
Dim dropdownList As String
Dim key As Variant
For Each key In z1Cache.Keys
For Each key In higaitouList.Keys
Dim displayText As String
displayText = MakeSelect(key, z1Cache(key)(0))
displayText = MakeSelect(key, higaitouList(key)(0))
If dropdownList = "" Then
dropdownList = displayText
Else
@@ -447,13 +447,13 @@ End Function
' Create MonthAmountKbn (AX) dropdown
Private Function BuildMonthAmountKbnList()
If z1Cache Is Nothing Then Call RefreshZ1Cache
If z3Cache Is Nothing Then Call RefreshZ3Cache
Dim dropdownList As String
Dim key As Variant
For Each key In z1Cache.Keys
For Each key In z3Cache.Keys
Dim displayText As String
displayText = MakeSelect(key, z1Cache(key)(0))
displayText = MakeSelect(key, z3Cache(key)(0))
If dropdownList = "" Then
dropdownList = displayText
Else
@@ -465,13 +465,13 @@ End Function
' Create Kanshoku (BC) dropdown
Private Function BuildKanshokuList()
If z1Cache Is Nothing Then Call RefreshZ1Cache
If o2Cache Is Nothing Then Call RefreshO2Cache
Dim dropdownList As String
Dim key As Variant
For Each key In z1Cache.Keys
For Each key In o2Cache.Keys
Dim displayText As String
displayText = MakeSelect(key, z1Cache(key)(0))
displayText = MakeSelect(key, o2Cache(key)(0))
If dropdownList = "" Then
dropdownList = displayText
Else