add error cache

This commit is contained in:
simple321vip
2026-04-20 21:15:59 +08:00
parent 1b851b2224
commit 14682d3504
5 changed files with 46 additions and 16 deletions

View File

@@ -5,7 +5,7 @@ Sub ImportModulesAndSheets_Safe()
Dim fso As Object Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject") Set fso = CreateObject("Scripting.FileSystemObject")
Const PROJECT_PATH As String = "D:\Project\upds7\vba\" Const PROJECT_PATH As String = "E:\AI\project\updsv7\vba\"
Const MODULE_PATH As String = PROJECT_PATH & "src\module" Const MODULE_PATH As String = PROJECT_PATH & "src\module"
Const SHEET_PATH As String = PROJECT_PATH & "src\sheet" Const SHEET_PATH As String = PROJECT_PATH & "src\sheet"

View File

@@ -320,6 +320,11 @@ Public Function FormatDateInput(ByVal inputStr As String) As String
End If End If
End Function End Function
Function ColNumToLetter(colNum As Long) As String Function GetErrorMsg(ByVal errorCode As String, Optional ByVal param As String = "") As String
ColNumToLetter = Split(Cells(1, colNum).Address, "$")(1) Dim errorList As Object: Set errorList = GetErrorList()
Dim errorMessage As String
If errorList.Exists(errorCode) Then
errorMessage = Replace(errorList(errorCode)(0), "{0}", param)
End If
GetErrorMsg = errorMessage
End Function End Function

View File

@@ -30,6 +30,7 @@ Private oufukuList As Object
Private koutaiList As Object Private koutaiList As Object
Private higaitouList As Object Private higaitouList As Object
Private kenshuList As Object Private kenshuList As Object
Private errorList As Object
Private sheetConfDict As Object Private sheetConfDict As Object
@@ -396,6 +397,24 @@ RefreshError:
Err.Raise 1001, "RefreshKenshuList", "Failed to load Enum lookup cache: " & Err.Description Err.Raise 1001, "RefreshKenshuList", "Failed to load Enum lookup cache: " & Err.Description
End Sub End Sub
' ============================================================
' higaitouList
' ============================================================
Private Sub RefreshErrorList()
On Error GoTo RefreshError
Set errorList = LoadLookup("Enum", keyCol:=18, valueCols:=Array(19), startRow:=3)
On Error GoTo 0
If errorList Is Nothing Or errorList.Count = 0 Then
Err.Raise 1003, "RefreshErrorList", "Enum reference data is empty"
End If
Exit Sub
RefreshError:
Err.Raise 1001, "RefreshErrorList", "Failed to load Enum lookup cache: " & Err.Description
End Sub
Private Sub RefreshSheetDict() Private Sub RefreshSheetDict()
Set sheetConfDict = CreateObject("Scripting.Dictionary") Set sheetConfDict = CreateObject("Scripting.Dictionary")
Dim sheetConf As Object Dim sheetConf As Object
@@ -638,6 +657,11 @@ Public Function GetKenshuList() As Object
Set GetKenshuList = kenshuList Set GetKenshuList = kenshuList
End Function End Function
Public Function GetErrorList() As Object
If errorList Is Nothing Then Call RefreshErrorList
Set GetErrorList = errorList
End Function
Public Function RefreshCache() As Boolean Public Function RefreshCache() As Boolean
Call RefreshM1Cache Call RefreshM1Cache
Call RefreshM1KukanDCache Call RefreshM1KukanDCache
@@ -653,5 +677,6 @@ Public Function RefreshCache() As Boolean
Call RefreshKoutaiList Call RefreshKoutaiList
Call RefreshHigaitouList Call RefreshHigaitouList
Call RefreshKenshuList Call RefreshKenshuList
Call RefreshErrorList
RefreshCache = True RefreshCache = True
End Function End Function

View File

@@ -603,7 +603,7 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
Dim col As Variant Dim col As Variant
For Each col In requiredCols For Each col In requiredCols
If Trim(Me.Range(col & rowNum).Value & "") = "" Then If Trim(Me.Range(col & rowNum).Value & "") = "" Then
Me.Cells(rowNum, errorCol).Value = col & " column is required" Me.Cells(rowNum, errorCol).Value = GetErrorMsg("E002", col & rowNum)
Me.Range(col & rowNum).Interior.Color = RGB(255, 0, 0) Me.Range(col & rowNum).Interior.Color = RGB(255, 0, 0)
Exit Sub Exit Sub
End If End If
@@ -615,7 +615,7 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
Dim cellDate As String: cellDate = Trim(Me.Cells(rowNum, colIndex).Value) Dim cellDate As String: cellDate = Trim(Me.Cells(rowNum, colIndex).Value)
If cellDate <> "" And Not IsDate(cellDate) Then If cellDate <> "" And Not IsDate(cellDate) Then
Dim letter As String: letter = Split(Me.Cells(1, colIndex).Address, "$")(1) Dim letter As String: letter = Split(Me.Cells(1, colIndex).Address, "$")(1)
Me.Cells(rowNum, errorCol).Value = letter & " column is invalid" Me.Cells(rowNum, errorCol).Value = GetErrorMsg("E001", letter & rowNum)
Me.Range(letter & rowNum).Interior.Color = RGB(255, 0, 0) Me.Range(letter & rowNum).Interior.Color = RGB(255, 0, 0)
Exit Sub Exit Sub
End If End If
@@ -625,7 +625,7 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
For Each col In NUMBER_COLS() For Each col In NUMBER_COLS()
Dim cellNumber As String: cellNumber = Trim(Me.Cells(rowNum, col).Value) Dim cellNumber As String: cellNumber = Trim(Me.Cells(rowNum, col).Value)
If cellNumber <> "" And Not IsNumeric(cellNumber) Then If cellNumber <> "" And Not IsNumeric(cellNumber) Then
Me.Cells(rowNum, errorCol).Value = col & " column is invalid" Me.Cells(rowNum, errorCol).Value = GetErrorMsg("E001", col & rowNum)
Me.Range(col & rowNum).Interior.Color = RGB(255, 0, 0) Me.Range(col & rowNum).Interior.Color = RGB(255, 0, 0)
Exit Sub Exit Sub
End If End If
@@ -637,7 +637,7 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
Dim z4Cache As Object: Set z4Cache = GetZ4Cache() Dim z4Cache As Object: Set z4Cache = GetZ4Cache()
Dim todokeCde As String: todokeCde = GetCode(Trim(Me.Cells(rowNum, ColG).Value)) Dim todokeCde As String: todokeCde = GetCode(Trim(Me.Cells(rowNum, ColG).Value))
If Not z4Cache.Exists(todokeCde) Then If Not z4Cache.Exists(todokeCde) Then
Me.Cells(rowNum, errorCol).Value = ColG & " column is invalid" Me.Cells(rowNum, errorCol).Value = GetErrorMsg("E001", ColG & rowNum)
Me.Range(ColG & rowNum).Interior.Color = RGB(255, 0, 0) Me.Range(ColG & rowNum).Interior.Color = RGB(255, 0, 0)
Exit Sub Exit Sub
End If End If
@@ -690,8 +690,8 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
Dim oufukuList As Object: Set oufukuList = GetOufukuList() Dim oufukuList As Object: Set oufukuList = GetOufukuList()
Dim oufukuCde As String: oufukuCde = GetCode(Trim(Me.Cells(rowNum, ColM).Value)) Dim oufukuCde As String: oufukuCde = GetCode(Trim(Me.Cells(rowNum, ColM).Value))
If Not oufukuList.Exists(oufukuCde) Then If Not oufukuList.Exists(oufukuCde) Then
Me.Cells(rowNum, errorCol).Value = ColM & " column is invalid" Me.Cells(rowNum, errorCol).Value = GetErrorMsg("E001", ColM & rowNum)
Me.Range(ColM & rowNum).Interior.Color = RGB(255, 0, 0) Me.Range(ColM & rowNum).Interior.Color = RGB(255, 0, 0)
Exit Sub Exit Sub
End If End If
@@ -701,8 +701,8 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
Dim koutaiList As Object: Set koutaiList = GetKoutaiList() Dim koutaiList As Object: Set koutaiList = GetKoutaiList()
Dim koutaiCde As String: koutaiCde = GetCode(Trim(Me.Cells(rowNum, ColN).Value)) Dim koutaiCde As String: koutaiCde = GetCode(Trim(Me.Cells(rowNum, ColN).Value))
If Not koutaiList.Exists(koutaiCde) Then If Not koutaiList.Exists(koutaiCde) Then
Me.Cells(rowNum, errorCol).Value = ColN & " column is invalid" Me.Cells(rowNum, errorCol).Value = ColN & " column is invalid"
Me.Range(ColN & rowNum).Interior.Color = RGB(255, 0, 0) Me.Range(ColN & rowNum).Interior.Color = RGB(255, 0, 0)
Exit Sub Exit Sub
End If End If
@@ -796,7 +796,7 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
If kukanCode <> "" Then If kukanCode <> "" Then
If kukanCodes.Exists(kukanCode) Then If kukanCodes.Exists(kukanCode) Then
kukanLetter = Split(Me.Cells(1, kukanCol).Address, "$")(1) kukanLetter = Split(Me.Cells(1, kukanCol).Address, "$")(1)
Me.Cells(rowNum, errorCol).Value = kukanLetter & " column is duplicated" Me.Cells(rowNum, errorCol).Value = GetErrorMsg("E003", kukanLetter & rowNum)
Me.Range(kukanLetter & rowNum).Interior.Color = RGB(255, 0, 0) Me.Range(kukanLetter & rowNum).Interior.Color = RGB(255, 0, 0)
Exit Sub Exit Sub
Else Else
@@ -815,24 +815,24 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
If linkCellValue = "1" Then If linkCellValue = "1" Then
' If code = "1", BB and BC must be empty ' If code = "1", BB and BC must be empty
If valBB <> "" Then If valBB <> "" Then
Me.Cells(rowNum, errorCol).Value = ColBB & " column must be empty" Me.Cells(rowNum, errorCol).Value = GetErrorMsg("E005", ColBB & rowNum)
Me.Range(ColBB & rowNum).Interior.Color = RGB(255, 0, 0) Me.Range(ColBB & rowNum).Interior.Color = RGB(255, 0, 0)
Exit Sub Exit Sub
End If End If
If valBC <> "" Then If valBC <> "" Then
Me.Cells(rowNum, errorCol).Value = ColBC & " column must be empty" Me.Cells(rowNum, errorCol).Value = GetErrorMsg("E005", ColBC & rowNum)
Me.Range(ColBC & rowNum).Interior.Color = RGB(255, 0, 0) Me.Range(ColBC & rowNum).Interior.Color = RGB(255, 0, 0)
Exit Sub Exit Sub
End If End If
ElseIf linkCellValue = "2" Then ElseIf linkCellValue = "2" Then
' If code = "2", BB and BC must have value ' If code = "2", BB and BC must have value
If valBB = "" Then If valBB = "" Then
Me.Cells(rowNum, errorCol).Value = ColBB & " column is required" Me.Cells(rowNum, errorCol).Value = GetErrorMsg("E002", ColBB & rowNum)
Me.Range(ColBB & rowNum).Interior.Color = RGB(255, 0, 0) Me.Range(ColBB & rowNum).Interior.Color = RGB(255, 0, 0)
Exit Sub Exit Sub
End If End If
If valBC = "" Then If valBC = "" Then
Me.Cells(rowNum, errorCol).Value = ColBC & " column is required" Me.Cells(rowNum, errorCol).Value = GetErrorMsg("E002", ColBC & rowNum)
Me.Range(ColBC & rowNum).Interior.Color = RGB(255, 0, 0) Me.Range(ColBC & rowNum).Interior.Color = RGB(255, 0, 0)
Exit Sub Exit Sub
End If End If