updsv7/vba
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

add error cache

Browse Source
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
Download Patch File Download Diff File Expand all files Collapse all files

2
src/init_module/Import_modules.bas
View File

@@ -5,7 +5,7 @@ Sub ImportModulesAndSheets_Safe()
Dim fso As Object
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 SHEET_PATH As String = PROJECT_PATH & "src\sheet"

9
src/module/Common_Functions.bas
View File

@@ -320,6 +320,11 @@ Public Function FormatDateInput(ByVal inputStr As String) As String
End If
End Function
Function ColNumToLetter(colNum As Long) As String
ColNumToLetter = Split(Cells(1, colNum).Address, "$")(1)
Function GetErrorMsg(ByVal errorCode As String, Optional ByVal param As String = "") As String
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

25
src/module/Common_Global_Cache.bas
View File

@@ -30,6 +30,7 @@ Private oufukuList As Object
Private koutaiList As Object
Private higaitouList As Object
Private kenshuList As Object
Private errorList As Object
Private sheetConfDict As Object
@@ -396,6 +397,24 @@ RefreshError:
Err.Raise 1001, "RefreshKenshuList", "Failed to load Enum lookup cache: " & Err.Description
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()
Set sheetConfDict = CreateObject("Scripting.Dictionary")
Dim sheetConf As Object
@@ -638,6 +657,11 @@ Public Function GetKenshuList() As Object
Set GetKenshuList = kenshuList
End Function
Public Function GetErrorList() As Object
If errorList Is Nothing Then Call RefreshErrorList
Set GetErrorList = errorList
End Function
Public Function RefreshCache() As Boolean
Call RefreshM1Cache
Call RefreshM1KukanDCache
@@ -653,5 +677,6 @@ Public Function RefreshCache() As Boolean
Call RefreshKoutaiList
Call RefreshHigaitouList
Call RefreshKenshuList
Call RefreshErrorList
RefreshCache = True
End Function

26
src/sheet/C1.cls
View File

@@ -603,7 +603,7 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
Dim col As Variant
For Each col In requiredCols
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)
Exit Sub
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)
If cellDate <> "" And Not IsDate(cellDate) Then
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)
Exit Sub
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()
Dim cellNumber As String: cellNumber = Trim(Me.Cells(rowNum, col).Value)
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)
Exit Sub
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 todokeCde As String: todokeCde = GetCode(Trim(Me.Cells(rowNum, ColG).Value))
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)
Exit Sub
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 oufukuCde As String: oufukuCde = GetCode(Trim(Me.Cells(rowNum, ColM).Value))
If Not oufukuList.Exists(oufukuCde) Then
Me.Cells(rowNum, errorCol).Value = ColM & " column is invalid"
Me.Range(ColM & rowNum).Interior.Color = RGB(255, 0, 0)
Me.Cells(rowNum, errorCol).Value = GetErrorMsg("E001", ColM & rowNum)
Me.Range(ColM & rowNum).Interior.Color = RGB(255, 0, 0)
Exit Sub
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 koutaiCde As String: koutaiCde = GetCode(Trim(Me.Cells(rowNum, ColN).Value))
If Not koutaiList.Exists(koutaiCde) Then
Me.Cells(rowNum, errorCol).Value = ColN & " column is invalid"
Me.Range(ColN & rowNum).Interior.Color = RGB(255, 0, 0)
Me.Cells(rowNum, errorCol).Value = ColN & " column is invalid"
Me.Range(ColN & rowNum).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
@@ -796,7 +796,7 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
If kukanCode <> "" Then
If kukanCodes.Exists(kukanCode) Then
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)
Exit Sub
Else
@@ -815,24 +815,24 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
If linkCellValue = "1" Then
' If code = "1", BB and BC must be empty
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)
Exit Sub
End If
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)
Exit Sub
End If
ElseIf linkCellValue = "2" Then
' If code = "2", BB and BC must have value
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)
Exit Sub
End If
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)
Exit Sub
End If