diff --git a/src/thisWorkbook/Master_M1_Kukan.bas b/src/thisWorkbook/Master_M1_Kukan.bas index 8b945c9..cd54ef4 100644 --- a/src/thisWorkbook/Master_M1_Kukan.bas +++ b/src/thisWorkbook/Master_M1_Kukan.bas @@ -1,10 +1,11 @@ ' ====== (222) ======= ' ====== Constants ====== -Const START_COL As Long = 3 -Const END_COL As Long = 14 +Const START_COL As Long = 3 ' C column +Const END_COL As Long = 14 ' N column +Const ERROR_COL As Long = 15 ' O column -Private z1Cache As Object ' +Private z1Cache As Object ' Z1 cache ' ====== Function ====== Public Sub RefreshZ1Cache() @@ -71,7 +72,7 @@ Sub ClearRowData(ByVal ws As Worksheet, ByVal rowNum As Long) ' Clear columns D onwards ws.Range(ws.Cells(rowNum, 4), ws.Cells(rowNum, 15)).ClearContents ws.Cells(rowNum, 6).Validation.Delete - ws.Cells(rowNum, 19).ClearContents ' Column Q - error info + ws.Cells(rowNum, ERROR_COL).ClearContents ' Column Q - error info End Sub Sub M1_Import() @@ -116,9 +117,9 @@ Sub M1_Import() Next j ' Auto-fill D, E columns from Z1 - ' Call FillFromZ1(wsTarget, writeRow, False) - - writeRow = writeRow + + Call FillFromZ1(writeRow) + + writeRow = writeRow + 1 Next i MsgBox writeRow - 7 & " rows imported.", vbInformation @@ -128,99 +129,91 @@ ImportError: MsgBox "CSV import failed: " & Err.Description, vbExclamation End Sub -Sub validate(ByVal rowNum As Long) +Sub validate(ByVal rowNum As Long, ByVal lastDataRow As Long) Set ws = Me - ' Check C column not empty - If Trim(ws.Cells(rowNum, 3).Value) = "" Then - ws.Cells(rowNum, 19).ClearContents - Exit Sub - End If - - ' Check G (column 9), H (column 10) required and numeric (for composite key) - If Trim(ws.Cells(rowNum, 9).Value) = "" Or Not IsNumeric(ws.Cells(rowNum, 9).Value) Then - ws.Cells(rowNum, 19).Value = "G column (I) is required and must be numeric" - Exit Sub - End If - - If Trim(ws.Cells(rowNum, 10).Value) = "" Or Not IsNumeric(ws.Cells(rowNum, 10).Value) Then - ws.Cells(rowNum, 19).Value = "H column (J) is required and must be numeric" - Exit Sub - End If - - ' Check I (column 11) required - If Trim(ws.Cells(rowNum, 11).Value) = "" Then - ws.Cells(rowNum, 19).Value = "I column (K) is required" - Exit Sub - End If - - ' Check J (column 12), K (column 13) required and numeric - If Trim(ws.Cells(rowNum, 12).Value) = "" Or Not IsNumeric(ws.Cells(rowNum, 12).Value) Then - ws.Cells(rowNum, 19).Value = "J column (L) is required and must be numeric" - Exit Sub - End If - - If Trim(ws.Cells(rowNum, 13).Value) = "" Or Not IsNumeric(ws.Cells(rowNum, 13).Value) Then - ws.Cells(rowNum, 19).Value = "K column (M) is required and must be numeric" - Exit Sub - End If - - ' Check L-P (columns 14-18) optional but must be numeric if entered - Dim col As Long - Dim colName As String - Dim colLetter As String - colLetter = "NOPQR" - - For col = 14 To 18 - If Trim(ws.Cells(rowNum, col).Value) <> "" And Not IsNumeric(ws.Cells(rowNum, col).Value) Then - colName = Mid(colLetter, col - 13, 1) - ws.Cells(rowNum, 19).Value = colName & " column must be numeric" + Dim clearRange As Range + Set clearRange = ws.Range(ws.Cells(rowNum, START_COL), ws.Cells(rowNum, END_COL)) + clearRange.Interior.Color = vbWhite + + ' Check column required + 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, ERROR_COL).Value = colLetter & " column is required" + ws.Range(colLetter & rowNum).Interior.Color = RGB(255, 0, 0) Exit Sub End If - Next col - - ' Check G-H composite key for duplicates - Dim g As String, h As String - Dim r As Long - Dim lastRow As Long - - g = Trim(ws.Cells(rowNum, 9).Value) - h = Trim(ws.Cells(rowNum, 10).Value) - - lastRow = ws.Cells(ws.Rows.Count, 3).End(xlUp).Row - - For r = 7 To lastRow - If r <> rowNum And Trim(ws.Cells(r, 3).Value) = Trim(ws.Cells(rowNum, 3).Value) Then - If Trim(ws.Cells(r, 9).Value) = g And Trim(ws.Cells(r, 10).Value) = h Then - ws.Cells(rowNum, 19).Value = "GH (I,J) combination already exists" - Exit Sub - End If + Next colLetter + + ' Check column numeric + For Each colLetter In Array("H", "I", "G", "N") + Dim val As String: val = Trim(ws.Range(colLetter & rowNum).Value) + If val <> "" And Not IsNumeric(val) Then + ws.Cells(rowNum, ERROR_COL).Value = colLetter & " column must be numeric" + ws.Range(colLetter & rowNum).Interior.Color = RGB(255, 0, 0) + Exit Sub End If - Next r - + Next colLetter + + ' Check C column repeat + Dim cValue As String: cValue = Trim(ws.Range("C" & rowNum).Value) + Dim foundCell As Range + Set foundCell = ws.Range("C7:C" & lastDataRow).Find(What:=cValue, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext) + If Not foundCell Is Nothing Then + If foundCell.Row <> rowNum Then + ws.Cells(rowNum, ERROR_COL).Value = "C column value is duplicated" + ws.Range("C" & rowNum).Interior.Color = RGB(255, 0, 0) + Exit Sub + End If + End If + + ' Check D and E column in the cache + If z1Cache Is Nothing Then Call RefreshZ1Cache + If z1Cache Is Nothing Then Exit Sub + + Dim dValue As String: dValue = Trim(ws.Range("D" & rowNum).Value) + Dim eValue As String: eValue = Trim(ws.Range("E" & rowNum).Value) + + If Not z1Cache.Exists(dValue) Then + ws.Cells(rowNum, ERROR_COL).Value = "D column does not exist." + ws.Range("D" & rowNum).Interior.Color = RGB(255, 0, 0) + Exit Sub + Else + Dim valueArray As Variant + valueArray = z1Cache(dValue) + If Not IsArray(valueArray) Or UBound(valueArray) < 0 Then + ws.Cells(rowNum, ERROR_COL).Value = "Invalid reference data for D column." + Exit Sub + End If + + Dim expectedEValue As String + expectedEValue = Trim(CStr(valueArray(0))) + + If eValue <> expectedEValue Then + ws.Cells(rowNum, ERROR_COL).Value = "E column does not match reference data." + ws.Range("E" & rowNum).Interior.Color = RGB(255, 0, 0) + Exit Sub + End If + End If + ' Validation passed - clear error - ws.Cells(rowNum, 19).ClearContents + ws.Cells(rowNum, ERROR_COL).ClearContents End Sub Sub validateButton() - Dim ws As Worksheet - Dim lastRow As Long - Dim r As Long - Dim errorCount As Long + Dim lastDataRow As Long, r As Long, errorCount As Long + lastDataRow = GetLastDataRowInRange(Me, START_COL, END_COL) - Set ws = Me - lastRow = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row - - If lastRow < 7 Then + If lastDataRow < 7 Then MsgBox "No data found.", vbExclamation Exit Sub End If - - errorCount = 0 - For r = 7 To lastRow - Call validate(ws, r) - If Trim(ws.Cells(r, 19).Value) <> "" Then + + For r = 7 To lastDataRow + Validate r, lastDataRow + If Trim(Cells(r, ERROR_COL).Value) <> "" Then errorCount = errorCount + 1 End If Next r @@ -242,8 +235,8 @@ Sub M1_Export() Dim r As Long, errorCount As Long For r = 7 To lastDataRow If Len(Trim(ws.Cells(r, 3).Value & "")) > 0 Then - Call validate(ws, r) - If Trim(ws.Cells(r, 19).Value) <> "" Then + Call validate(r, lastDataRow) + If Trim(ws.Cells(r, ERROR_COL).Value) <> "" Then errorCount = errorCount + 1 End If End If diff --git a/src/thisWorkbook/Master_Z1_222.bas b/src/thisWorkbook/Master_Z1_222.bas index 50dea64..0d233ff 100644 --- a/src/thisWorkbook/Master_Z1_222.bas +++ b/src/thisWorkbook/Master_Z1_222.bas @@ -3,6 +3,7 @@ ' ====== Constants ====== Const START_COL As Long = 3 Const END_COL As Long = 9 +Const ERROR_COL As Long = 2 ' ====== Function ====== Sub Z1_ClearRowData(ByVal ws As Worksheet, ByVal rowNum As Long) @@ -149,7 +150,7 @@ Sub Z1_validateButton() errorCount = 0 For r = 7 To lastDataRow Validate r - If Trim(Cells(r, 2).Value) <> "" Then + If Trim(Cells(r, ERROR_COL).Value) <> "" Then errorCount = errorCount + 1 End If Next r diff --git a/src/thisWorkbook/Master_Z2_223.bas b/src/thisWorkbook/Master_Z2_223.bas index d6e7dea..d1329da 100644 --- a/src/thisWorkbook/Master_Z2_223.bas +++ b/src/thisWorkbook/Master_Z2_223.bas @@ -3,6 +3,7 @@ ' ====== Constants ====== Const START_COL As Long = 3 Const END_COL As Long = 7 +Const ERROR_COL As Long = 2 ' ====== Function ====== Sub Z2_ClearRowData(ByVal ws As Worksheet, ByVal rowNum As Long) @@ -133,7 +134,7 @@ Sub Z2_validateButton() errorCount = 0 For r = 7 To lastDataRow Validate r - If Trim(Cells(r, 2).Value) <> "" Then + If Trim(Cells(r, ERROR_COL).Value) <> "" Then errorCount = errorCount + 1 End If Next r diff --git a/src/thisWorkbook/Master_Z3_224.bas b/src/thisWorkbook/Master_Z3_224.bas index ba261cb..baf237c 100644 --- a/src/thisWorkbook/Master_Z3_224.bas +++ b/src/thisWorkbook/Master_Z3_224.bas @@ -3,6 +3,7 @@ ' ====== Constants ====== Const START_COL As Long = 3 Const END_COL As Long = 8 +Const ERROR_COL As Long = 2 ' ====== Function ====== Sub Z3_ClearRowData(ByVal ws As Worksheet, ByVal rowNum As Long) @@ -141,7 +142,7 @@ Sub Z3_validateButton() errorCount = 0 For r = 7 To lastDataRow Validate r - If Trim(Cells(r, 2).Value) <> "" Then + If Trim(Cells(r, ERROR_COL).Value) <> "" Then errorCount = errorCount + 1 End If Next r diff --git a/通勤手当テンプレート_案.xlsm b/通勤手当テンプレート_案.xlsm index 42c9948..a304f4a 100644 Binary files a/通勤手当テンプレート_案.xlsm and b/通勤手当テンプレート_案.xlsm differ