diff --git a/src/module/Common_Functions.bas b/src/module/Common_Functions.bas index f49fbf7..c9be4cd 100644 --- a/src/module/Common_Functions.bas +++ b/src/module/Common_Functions.bas @@ -389,6 +389,18 @@ Function CheckVarcharOver(ByVal ws As Worksheet, ByVal rowNum As Long, ByVal col CheckVarcharOver = True End Function +Function CheckNumberOver(ByVal ws As Worksheet, ByVal rowNum As Long, ByVal colNum As Long, ByVal numberLength As Long, ByVal errorCol As String) + Dim checkValue As String: checkValue = Trim(ws.Cells(rowNum, colNum).Value) + If Len(checkValue) > numberLength Then + Dim letter As String: letter = ColLetter(colNum) + ws.Cells(rowNum, errorCol).Value = GetErrorMsg("E014", letter & rowNum, numberLength) + ws.Cells(rowNum, colNum).Interior.Color = RGB(255, 0, 0) + CheckNumberOver = False + Exit Function + End If + CheckNumberOver = True +End Function + Function Check01(ByVal ws As Worksheet, ByVal rowNum As Long, ByVal colNum As Long, ByVal errorCol As String) Dim checkValue As String: checkValue = Trim(ws.Cells(rowNum, colNum).Value) Dim letter As String: letter = ColLetter(colNum) @@ -446,14 +458,21 @@ Function CheckDuplicate(ByVal ws As Worksheet, ByVal rowNum As Long, ByVal colNu CheckDuplicate = True End Function -Function CheckNumber(ByVal ws As Worksheet, ByVal rowNum As Long, ByVal colNum As Long, ByVal varcharLength As Long, ByVal errorCol As String) +Function CheckNumber(ByVal ws As Worksheet, ByVal rowNum As Long, ByVal colNum As Long, ByVal errorCol As String) As Boolean Dim checkValue As String: checkValue = Trim(ws.Cells(rowNum, colNum).Value) - If Len(checkValue) > varcharLength Then - Dim letter As String: letter = ColLetter(colNum) - ws.Cells(rowNum, errorCol).Value = GetErrorMsg("E011", letter & rowNum) - ws.Cells(rowNum, colNum).Interior.Color = RGB(255, 0, 0) - CheckVarcharOver = False + Dim letter As String: letter = ColLetter(colNum) + + If checkValue = "" Then + CheckNumber = True Exit Function End If - CheckVarcharOver = True + + If Not IsNumeric(checkValue) Then + ws.Cells(rowNum, errorCol).Value = GetErrorMsg("E011", letter & rowNum) + ws.Cells(rowNum, colNum).Interior.Color = RGB(255, 0, 0) + CheckNumber = False + Exit Function + End If + + CheckNumber = True End Function diff --git a/src/module/Common_Global_Cache.bas b/src/module/Common_Global_Cache.bas index e15304c..bca43cd 100644 --- a/src/module/Common_Global_Cache.bas +++ b/src/module/Common_Global_Cache.bas @@ -22,6 +22,9 @@ Private z1Cache As Object Private z2Cache As Object Private z3Cache As Object Private z4Cache As Object +Private t1Cache As Object +Private t2Cache As Object +Private t3Cache As Object Private o1Cache As Object Private o2Cache As Object Private m2Cache As Object @@ -235,6 +238,66 @@ RefreshError: Err.Raise 1001, "RefreshZ4Cache", "Failed to load Enum lookup cache: " & Err.Description End Sub +' ============================================================ +' T1 Cache +' ============================================================ +Private Sub RefreshT1Cache() + Set t1Cache = Nothing + + On Error GoTo RefreshError + Set t1Cache = LoadLookup("T1", keyCol:=3, valueCols:=Array(4), startRow:=7) + On Error GoTo 0 + + If t1Cache Is Nothing Or t1Cache.Count = 0 Then + Err.Raise 1001, "RefreshT1Cache", "T1 reference data is empty" + End If + + Exit Sub + +RefreshError: + Err.Raise 1002, "RefreshT1Cache", "Failed to load T1 lookup cache: " & Err.Description +End Sub + +' ============================================================ +' T2 Cache +' ============================================================ +Private Sub RefreshT2Cache() + Set t2Cache = Nothing + + On Error GoTo RefreshError + Set t2Cache = LoadLookup("T2", keyCol:=3, valueCols:=Array(4), startRow:=7) + On Error GoTo 0 + + If t2Cache Is Nothing Or t2Cache.Count = 0 Then + Err.Raise 1001, "RefreshT2Cache", "T2 reference data is empty" + End If + + Exit Sub + +RefreshError: + Err.Raise 1002, "RefreshT2Cache", "Failed to load T2 lookup cache: " & Err.Description +End Sub + +' ============================================================ +' T3 Cache +' ============================================================ +Private Sub RefreshT3Cache() + Set t3Cache = Nothing + + On Error GoTo RefreshError + Set t3Cache = LoadLookup("T3", keyCol:=3, valueCols:=Array(4), startRow:=7) + On Error GoTo 0 + + If t3Cache Is Nothing Or t3Cache.Count = 0 Then + Err.Raise 1001, "RefreshT3Cache", "T3 reference data is empty" + End If + + Exit Sub + +RefreshError: + Err.Raise 1002, "RefreshT3Cache", "Failed to load T3 lookup cache: " & Err.Description +End Sub + ' ============================================================ ' O1 Cache ' ============================================================ @@ -546,6 +609,60 @@ Private Sub RefreshSheetDict() Set sheetConfDict("Z4") = sheetConf + ' T1 + Set sheetConf = CreateObject("Scripting.Dictionary") + + sheetConf("StartCol") = "C" + sheetConf("EndCol") = "G" + sheetConf("ErrorCol") = "B" + sheetConf("StartRow") = 7 + sheetConf("HeaderRow") = 5 + sheetConf("RefreshCacheName") = "RefreshT1Cache" + sheetConf("CSV_Encoding") = "utf-8" + sheetConf("HasHeader") = False + sheetConf("ExpectedColumnCount") = 5 + sheetConf("HeaderColumns") = Array("C", "D", "E", "F", "G") + sheetConf("AlwaysQuote") = True + sheetConf("FilterRow") = 6 + + Set sheetConfDict("T1") = sheetConf + + ' T2 + Set sheetConf = CreateObject("Scripting.Dictionary") + + sheetConf("StartCol") = "C" + sheetConf("EndCol") = "M" + sheetConf("ErrorCol") = "B" + sheetConf("StartRow") = 7 + sheetConf("HeaderRow") = 5 + sheetConf("RefreshCacheName") = "RefreshT2Cache" + sheetConf("CSV_Encoding") = "utf-8" + sheetConf("HasHeader") = False + sheetConf("ExpectedColumnCount") = 11 + sheetConf("HeaderColumns") = Array("C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M") + sheetConf("AlwaysQuote") = True + sheetConf("FilterRow") = 6 + + Set sheetConfDict("T2") = sheetConf + + ' T3 + Set sheetConf = CreateObject("Scripting.Dictionary") + + sheetConf("StartCol") = "C" + sheetConf("EndCol") = "I" + sheetConf("ErrorCol") = "B" + sheetConf("StartRow") = 7 + sheetConf("HeaderRow") = 5 + sheetConf("RefreshCacheName") = "RefreshT3Cache" + sheetConf("CSV_Encoding") = "utf-8" + sheetConf("HasHeader") = False + sheetConf("ExpectedColumnCount") = 7 + sheetConf("HeaderColumns") = Array("C", "D", "E", "F", "G", "H", "I") + sheetConf("AlwaysQuote") = True + sheetConf("FilterRow") = 6 + + Set sheetConfDict("T3") = sheetConf + ' O1 Set sheetConf = CreateObject("Scripting.Dictionary") @@ -623,6 +740,21 @@ Public Function GetZ4Cache() As Object Set GetZ4Cache = z4Cache End Function +Public Function GetT1Cache() As Object + If t1Cache Is Nothing Then Call RefreshT1Cache + Set GetT1Cache = t1Cache +End Function + +Public Function GetT2Cache() As Object + If t2Cache Is Nothing Then Call RefreshT2Cache + Set GetT2Cache = t2Cache +End Function + +Public Function GetT3Cache() As Object + If t3Cache Is Nothing Then Call RefreshT3Cache + Set GetT3Cache = t3Cache +End Function + Public Function GetO1Cache() As Object If o1Cache Is Nothing Then Call RefreshO1Cache Set GetO1Cache = o1Cache @@ -671,6 +803,9 @@ Public Function RefreshCache() As Boolean Call RefreshZ2Cache Call RefreshZ3Cache Call RefreshZ4Cache + Call RefreshT1Cache + Call RefreshT2Cache + Call RefreshT3Cache Call RefreshO1Cache Call RefreshO2Cache Call RefreshTokubetu diff --git a/src/sheet/M1.cls b/src/sheet/M1.cls index 23371d1..24d8cf3 100644 --- a/src/sheet/M1.cls +++ b/src/sheet/M1.cls @@ -86,7 +86,7 @@ Private Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As Dim colLetter As Variant For Each colLetter In Array("C", "D", "E", "F", "G", "I", "L") If Trim(ws.Range(colLetter & rowNum).Value) = "" Then - ws.Cells(rowNum, errorCol).Value = colLetter & " column is required" + ws.Cells(rowNum, errorCol).Value = GetErrorMsg("E002", colLetter & rowNum) ws.Range(colLetter & rowNum).Interior.Color = RGB(255, 0, 0) Exit Sub End If @@ -96,7 +96,7 @@ Private Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As For Each colLetter In Array("H", "I", "J", "N") Dim val As String: val = Trim(ws.Range(colLetter & rowNum).Value) If val <> "" And Not IsNumeric(val) Then - ws.Cells(rowNum, errorCol).Value = colLetter & " column must be numeric" + ws.Cells(rowNum, errorCol).Value = GetErrorMsg("E011", colLetter & rowNum) ws.Range(colLetter & rowNum).Interior.Color = RGB(255, 0, 0) Exit Sub End If @@ -121,7 +121,7 @@ Private Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As Dim eValue As String: eValue = Trim(ws.Range("E" & rowNum).Value) If Not z1Cache.Exists(dValue) Then - ws.Cells(rowNum, errorCol).Value = "D column does not exist." + ws.Cells(rowNum, errorCol).Value = GetErrorMsg("E004", "D" & rowNum) ws.Range("D" & rowNum).Interior.Color = RGB(255, 0, 0) Exit Sub Else @@ -143,7 +143,6 @@ Private Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As End If ' Check L column in the tokubetuList - Dim tokubetuList As Object: Set tokubetuList = GetTokubetu() Dim lValue As String: lValue = Trim(ws.Range("L" & rowNum).Value) If Not tokubetuList.Exists(lValue) Then diff --git a/src/sheet/M2.cls b/src/sheet/M2.cls index 7825bfb..63deae3 100644 --- a/src/sheet/M2.cls +++ b/src/sheet/M2.cls @@ -122,6 +122,23 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As Exit Sub End If + ' check Duplicate + Dim i As Long + Dim code As String: code = Trim(ws.Range("J" & rowNum).Value) + Dim name As String: name = Trim(ws.Range("K" & rowNum).Value) + For i = 7 To rowNum - 1 + If Trim(ws.Cells(i, "C").Value) = cValue And Trim(ws.Cells(i, "I").Value) = kenshuKbn And Trim(ws.Cells(i, "J").Value) = code Then + ws.Cells(rowNum, errorCol).Value = GetErrorMsg("E013", i, checkValue) + ws.Cells(rowNum, "C").Interior.Color = RGB(255, 0, 0) + Exit Sub + End If + If Trim(ws.Cells(i, "C").Value) = cValue And Trim(ws.Cells(i, "I").Value) = kenshuKbn And Trim(ws.Cells(i, "K").Value) = name Then + ws.Cells(rowNum, errorCol).Value = GetErrorMsg("E013", i, checkValue) + ws.Cells(rowNum, "C").Interior.Color = RGB(255, 0, 0) + Exit Sub + End If + Next i + ws.Cells(rowNum, errorCol).ClearContents End Sub diff --git a/src/sheet/T1.cls b/src/sheet/T1.cls new file mode 100644 index 0000000..12fbf98 --- /dev/null +++ b/src/sheet/T1.cls @@ -0,0 +1,57 @@ +' ============================================================ +' Module Name: Master_244 +' Module Desc: T1 master data management (244) +' Module Methods: +' - Validate +' ============================================================ +' +Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As Long) + + Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig() + Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName) + + Dim startCol As String: startCol = sheetConf("StartCol") + Dim endCol As String: endCol = sheetConf("EndCol") + Dim errorCol As String: errorCol = sheetConf("ErrorCol") + + ' clear C~I columns background color + Dim clearRange As Range: Set clearRange = ws.Range(ws.Cells(rowNum, startCol), ws.Cells(rowNum, endCol)) + clearRange.Interior.Color = vbWhite + + ' C column check + checkResult = CheckRequired(ws, rowNum, 3, errorCol) + If checkResult = False Then Exit Sub + + checkResult = CheckChar(ws, rowNum, 3, 3, errorCol) + If checkResult = False Then Exit Sub + + checkResult = CheckAlphanumeric(ws, rowNum, 3, 3, errorCol) + If checkResult = False Then Exit Sub + + checkResult = CheckDuplicate(ws, rowNum, 3, errorCol) + If checkResult = False Then Exit Sub + + ' D column check + checkResult = CheckRequired(ws, rowNum, 4, errorCol) + If checkResult = False Then Exit Sub + + checkResult = CheckVarcharOver(ws, rowNum, 4, 80, errorCol) + If checkResult = False Then Exit Sub + + ' E column check + checkResult = CheckRequired(ws, rowNum, 5, errorCol) + If checkResult = False Then Exit Sub + + checkResult = CheckVarcharOver(ws, rowNum, 5, 80, errorCol) + If checkResult = False Then Exit Sub + + ' F column check + checkResult = CheckVarcharOver(ws, rowNum, 6, 80, errorCol) + If checkResult = False Then Exit Sub + + ' G column check + checkResult = Check01(ws, rowNum, 7, errorCol) + If checkResult = False Then Exit Sub + + ws.Cells(rowNum, errorCol).ClearContents +End Sub diff --git a/src/sheet/T2.cls b/src/sheet/T2.cls new file mode 100644 index 0000000..6f156ce --- /dev/null +++ b/src/sheet/T2.cls @@ -0,0 +1,117 @@ +' ============================================================ +' Module Name: Master_245 +' Module Desc: T2 master data management (245) +' Module Methods: +' - Validate +' ============================================================ +' +Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As Long) + + Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig() + Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName) + + Dim startCol As String: startCol = sheetConf("StartCol") + Dim endCol As String: endCol = sheetConf("EndCol") + Dim errorCol As String: errorCol = sheetConf("ErrorCol") + + ' clear C~I columns background color + Dim clearRange As Range: Set clearRange = ws.Range(ws.Cells(rowNum, startCol), ws.Cells(rowNum, endCol)) + clearRange.Interior.Color = vbWhite + + ' C column check + checkResult = CheckRequired(ws, rowNum, 3, errorCol) + If checkResult = False Then Exit Sub + + checkResult = CheckChar(ws, rowNum, 3, 3, errorCol) + If checkResult = False Then Exit Sub + + checkResult = CheckAlphanumeric(ws, rowNum, 3, 3, errorCol) + If checkResult = False Then Exit Sub + + checkResult = CheckDuplicate(ws, rowNum, 3, errorCol) + If checkResult = False Then Exit Sub + + ' D column check + checkResult = CheckRequired(ws, rowNum, 4, errorCol) + If checkResult = False Then Exit Sub + + checkResult = CheckVarcharOver(ws, rowNum, 4, 80, errorCol) + If checkResult = False Then Exit Sub + + ' E column check + checkResult = CheckRequired(ws, rowNum, 5, errorCol) + If checkResult = False Then Exit Sub + + checkResult = CheckVarcharOver(ws, rowNum, 5, 80, errorCol) + If checkResult = False Then Exit Sub + + ' F column check + checkResult = CheckVarcharOver(ws, rowNum, 6, 80, errorCol) + If checkResult = False Then Exit Sub + + ' G column check + checkResult = Check01(ws, rowNum, 7, errorCol) + If checkResult = False Then Exit Sub + + ' H column check number + checkResult = CheckRequired(ws, rowNum, 8, errorCol) + If checkResult = False Then Exit Sub + + checkResult = CheckNumber(ws, rowNum, 8, errorCol) + If checkResult = False Then Exit Sub + + checkResult = CheckNumberOver(ws, rowNum, 8, 6, errorCol) + If checkResult = False Then Exit Sub + + ' I column check number + checkResult = CheckRequired(ws, rowNum, 9, errorCol) + If checkResult = False Then Exit Sub + + checkResult = CheckNumber(ws, rowNum, 9, errorCol) + If checkResult = False Then Exit Sub + + checkResult = CheckNumberOver(ws, rowNum, 9, 5, errorCol) + If checkResult = False Then Exit Sub + + ' J column check number + checkResult = CheckRequired(ws, rowNum, 10, errorCol) + If checkResult = False Then Exit Sub + + checkResult = CheckNumber(ws, rowNum, 10, errorCol) + If checkResult = False Then Exit Sub + + checkResult = CheckNumberOver(ws, rowNum, 10, 3, errorCol) + If checkResult = False Then Exit Sub + + ' K column check number + checkResult = CheckRequired(ws, rowNum, 11, errorCol) + If checkResult = False Then Exit Sub + + checkResult = CheckNumber(ws, rowNum, 11, errorCol) + If checkResult = False Then Exit Sub + + checkResult = CheckNumberOver(ws, rowNum, 11, 5, errorCol) + If checkResult = False Then Exit Sub + + ' L column check number + checkResult = CheckRequired(ws, rowNum, 12, errorCol) + If checkResult = False Then Exit Sub + + checkResult = CheckNumber(ws, rowNum, 12, errorCol) + If checkResult = False Then Exit Sub + + checkResult = CheckNumberOver(ws, rowNum, 12, 3, errorCol) + If checkResult = False Then Exit Sub + + ' M column check number + checkResult = CheckRequired(ws, rowNum, 13, errorCol) + If checkResult = False Then Exit Sub + + checkResult = CheckNumber(ws, rowNum, 13, errorCol) + If checkResult = False Then Exit Sub + + checkResult = CheckNumberOver(ws, rowNum, 13, 5, errorCol) + If checkResult = False Then Exit Sub + + ws.Cells(rowNum, errorCol).ClearContents +End Sub diff --git a/src/sheet/T3.cls b/src/sheet/T3.cls new file mode 100644 index 0000000..877df96 --- /dev/null +++ b/src/sheet/T3.cls @@ -0,0 +1,77 @@ +' ============================================================ +' Module Name: Master_246 +' Module Desc: T3 master data management (246) +' Module Methods: +' - Validate +' ============================================================ +' +Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As Long) + + Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig() + Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName) + + Dim startCol As String: startCol = sheetConf("StartCol") + Dim endCol As String: endCol = sheetConf("EndCol") + Dim errorCol As String: errorCol = sheetConf("ErrorCol") + + ' clear C~I columns background color + Dim clearRange As Range: Set clearRange = ws.Range(ws.Cells(rowNum, startCol), ws.Cells(rowNum, endCol)) + clearRange.Interior.Color = vbWhite + + ' C column check + checkResult = CheckRequired(ws, rowNum, 3, errorCol) + If checkResult = False Then Exit Sub + + checkResult = CheckChar(ws, rowNum, 3, 3, errorCol) + If checkResult = False Then Exit Sub + + checkResult = CheckAlphanumeric(ws, rowNum, 3, 3, errorCol) + If checkResult = False Then Exit Sub + + checkResult = CheckDuplicate(ws, rowNum, 3, errorCol) + If checkResult = False Then Exit Sub + + ' D column check + checkResult = CheckRequired(ws, rowNum, 4, errorCol) + If checkResult = False Then Exit Sub + + checkResult = CheckVarcharOver(ws, rowNum, 4, 80, errorCol) + If checkResult = False Then Exit Sub + + ' E column check + checkResult = CheckRequired(ws, rowNum, 5, errorCol) + If checkResult = False Then Exit Sub + + checkResult = CheckVarcharOver(ws, rowNum, 5, 80, errorCol) + If checkResult = False Then Exit Sub + + ' F column check + checkResult = CheckVarcharOver(ws, rowNum, 6, 80, errorCol) + If checkResult = False Then Exit Sub + + ' G column check + checkResult = Check01(ws, rowNum, 7, errorCol) + If checkResult = False Then Exit Sub + + ' H column check number + checkResult = CheckRequired(ws, rowNum, 8, errorCol) + If checkResult = False Then Exit Sub + + checkResult = CheckNumber(ws, rowNum, 8, errorCol) + If checkResult = False Then Exit Sub + + checkResult = CheckNumberOver(ws, rowNum, 8, 6, errorCol) + If checkResult = False Then Exit Sub + + ' I column check number + checkResult = CheckRequired(ws, rowNum, 9, errorCol) + If checkResult = False Then Exit Sub + + checkResult = CheckNumber(ws, rowNum, 9, errorCol) + If checkResult = False Then Exit Sub + + checkResult = CheckNumberOver(ws, rowNum, 9, 6, errorCol) + If checkResult = False Then Exit Sub + + ws.Cells(rowNum, errorCol).ClearContents +End Sub diff --git a/通勤手当テンプレート_案.xlsm b/通勤手当テンプレート_案.xlsm index 702c33f..516a09a 100644 Binary files a/通勤手当テンプレート_案.xlsm and b/通勤手当テンプレート_案.xlsm differ