add error cache
This commit is contained in:
@@ -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"
|
||||||
|
|
||||||
|
|||||||
@@ -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
|
||||||
|
|||||||
@@ -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
|
||||||
@@ -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
|
||||||
|
|||||||
Binary file not shown.
Reference in New Issue
Block a user