update Generic Master bas4

This commit is contained in:
updsv7
2026-04-15 11:01:25 +09:00
parent d89fc2e8b1
commit 5e906f3300
8 changed files with 12 additions and 1 deletions

View File

@@ -0,0 +1,154 @@
' ====== (223) =======
Sub Z2_ClearRowData(ByVal ws As Worksheet, ByVal rowNum As Long)
Call Generic_Master_ClearRowData(ws, rowNum)
End Sub
Sub Z2_Import()
Call Generic_Master_Import(Me, 5)
End Sub
Sub Z2_Export()
Dim lastDataRow As Long: lastDataRow = GetLastDataRow(Me, 3)
If lastDataRow < 7 Then
MsgBox "No data rows to output.", vbExclamation
Exit Sub
End If
Dim r As Long
Dim errorCount As Long
For r = 7 To lastDataRow
Validate r
If Trim(Cells(r, 2).Value & "") <> "" Then
errorCount = errorCount + 1
End If
Next r
If errorCount > 0 Then
MsgBox "Validation failed. Found " & errorCount & " error(s). Please correct them before exporting.", vbCritical
Exit Sub
End If
Call Generic_Master_Export(Me, 5, lastDataRow)
End Sub
Sub Validate(ByVal rowNum As Long)
Dim cValue As String
Set ws = Me
cValue = Trim(ws.Cells(rowNum, 3).Value)
' clear C~I columns background color
Dim clearRange As Range
Set clearRange = ws.Range(ws.Cells(rowNum, 3), ws.Cells(rowNum, 7))
clearRange.Interior.Color = vbWhite
If cValue = "" Then
ws.Cells(rowNum, 2).Value = "C column is required"
ws.Cells(rowNum, 3).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
If Len(cValue) <> 3 Then
ws.Cells(rowNum, 2).Value = "C column must be 3 characters"
ws.Cells(rowNum, 3).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
Dim i As Long
Dim ch As String
For i = 1 To 3
ch = Mid(cValue, i, 1)
If Not ((ch >= "0" And ch <= "9") Or (ch >= "A" And ch <= "Z") Or (ch >= "a" And ch <= "z")) Then
ws.Cells(rowNum, 2).Value = "C column must be alphanumeric"
ws.Cells(rowNum, 3).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
Next i
Dim dValue As String
dValue = Trim(ws.Cells(rowNum, 4).Value)
If dValue = "" Then
ws.Cells(rowNum, 2).Value = "D column is required"
ws.Cells(rowNum, 4).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
If Len(dValue) > 80 Then
ws.Cells(rowNum, 2).Value = "D column must be within 80 characters"
ws.Cells(rowNum, 4).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
Dim eValue As String
eValue = Trim(ws.Cells(rowNum, 5).Value)
If eValue = "" Then
ws.Cells(rowNum, 2).Value = "E column is required"
ws.Cells(rowNum, 5).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
If Len(eValue) > 80 Then
ws.Cells(rowNum, 2).Value = "E column must be within 80 characters"
ws.Cells(rowNum, 5).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
Dim fValue As String
fValue = Trim(ws.Cells(rowNum, 6).Value)
If fValue <> "" And Len(fValue) > 80 Then
ws.Cells(rowNum, 2).Value = "F column must be within 80 characters"
ws.Cells(rowNum, 6).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
Dim hValue As String
hValue = Trim(ws.Cells(rowNum, 7).Value)
If hValue <> "" Then
If Len(hValue) <> 1 Then
ws.Cells(rowNum, 2).Value = "G column must be 1 digit"
ws.Cells(rowNum, 7).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
If hValue <> "0" And hValue <> "1" Then
ws.Cells(rowNum, 2).Value = "G column must be 0 or 1"
ws.Cells(rowNum, 7).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
End If
ws.Cells(rowNum, 2).ClearContents
End Sub
Sub Z2_validateButton()
Dim lastRow As Long
Dim r As Long
Dim errorCount As Long
lastRow = GetLastDataRow(Me, 3)
If lastRow < 7 Then
MsgBox "No data found.", vbExclamation
Exit Sub
End If
errorCount = 0
For r = 7 To lastRow
Validate r
If Trim(Cells(r, 2).Value) <> "" Then
errorCount = errorCount + 1
End If
Next r
MsgBox "Validation complete. Errors: " & errorCount, vbInformation
End Sub
Sub Z2_SortDataRowsByC()
Call SortDataRows(3)
End Sub
Sub Z2_ToggleAutoFilter()
Call ToggleAutoFilter(6)
End Sub
Sub Z2_AutoFitColumnWidth()
Call AutoFitColumnWidth(2, 7)
End Sub