update Generic Master bas7

This commit is contained in:
updsv7
2026-04-15 16:32:30 +09:00
parent 0bf7ae628a
commit 20f04cd9bd
5 changed files with 87 additions and 91 deletions

View File

@@ -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)
Call FillFromZ1(writeRow)
writeRow = 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
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 colLetter
' 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"
' 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 colLetter
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"
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"
' 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
Next r
' 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

View File

@@ -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

View File

@@ -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

View File

@@ -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