Rewrite Z1 with common functions

This commit is contained in:
updsv7
2026-04-13 18:26:55 +09:00
parent a09be7b27b
commit 8497105702

View File

@@ -1,7 +1,6 @@
Sub Z1_ClearRowData(ByVal ws As Worksheet, ByVal rowNum As Long)
' Clear from D column onwards
ws.Range(ws.Cells(rowNum, 4), ws.Cells(rowNum, 15)).ClearContents
ws.Cells(rowNum, 2).ClearContents ' Q column error info
ws.Cells(rowNum, 2).ClearContents
End Sub
Sub Z1_ImportMasterDetailData()
@@ -11,95 +10,97 @@ Sub Z1_ImportMasterDetailData()
Dim i As Long
Dim dataArray As Variant
Dim code As String
Dim lastRow As Long
Dim r As Long
' Target this worksheet
Dim writeRow As Long
Set wsTarget = Me
' === Step 1: Select CSV file ===
' Step 1: Select CSV file
filePath = SelectCSVFile()
If filePath = "" Then Exit Sub
' === Step 2: Read CSV ===
' Step 2: Read CSV
lines = ReadCSVFile(filePath)
' === Validate: check all rows have 7 columns ===
' Step 3: Validate column count
If Not ValidateCSVColumnCount(lines, 7) Then Exit Sub
' === Clear data rows before import ===
' Step 4: Clear data rows
Call ClearDataRows(wsTarget, 7, 3)
If UBound(lines) < 0 Then
MsgBox "No data in CSV.", vbExclamation
Exit Sub
End If
' === Collect CSV codes and data ===
Dim csvData As Object
Set csvData = CreateObject("Scripting.Dictionary")
For i = 0 To UBound(lines)
If Trim(lines(i)) = "" Then GoTo NextCsvLine
dataArray = Split(lines(i), ",")
If UBound(dataArray) >= 0 Then
code = CleanCSVField(CStr(dataArray(0)))
If code <> "" Then
' Use unique key: code + "_" + row index to avoid duplicate key error
csvData.Add code & "_" & i, dataArray
End If
End If
NextCsvLine:
Next i
If csvData.Count = 0 Then
MsgBox "No valid code found.", vbExclamation
Exit Sub
End If
' === Step 6: Write CSV data to next available row ===
' Step 5: Import data
writeRow = 7
For i = 0 To UBound(lines)
If Trim(lines(i)) = "" Then GoTo NextLine
dataArray = Split(lines(i), ",")
' CSV col1-7 -> C-I column (3-9)
wsTarget.Cells(writeRow, 3).Value = CleanCSVField(CStr(dataArray(0)))
wsTarget.Cells(writeRow, 4).Value = CleanCSVField(CStr(dataArray(1)))
wsTarget.Cells(writeRow, 5).Value = CleanCSVField(CStr(dataArray(2)))
wsTarget.Cells(writeRow, 6).Value = CleanCSVField(CStr(dataArray(3)))
wsTarget.Cells(writeRow, 7).Value = CleanCSVField(CStr(dataArray(4)))
wsTarget.Cells(writeRow, 8).Value = CleanCSVField(CStr(dataArray(5)))
wsTarget.Cells(writeRow, 9).Value = CleanCSVField(CStr(dataArray(6)))
writeRow = writeRow + 1
NextLine:
If Trim(lines(i)) <> "" Then
dataArray = Split(lines(i), ",")
wsTarget.Cells(writeRow, 3).Value = CleanCSVField(CStr(dataArray(0)))
wsTarget.Cells(writeRow, 4).Value = CleanCSVField(CStr(dataArray(1)))
wsTarget.Cells(writeRow, 5).Value = CleanCSVField(CStr(dataArray(2)))
wsTarget.Cells(writeRow, 6).Value = CleanCSVField(CStr(dataArray(3)))
wsTarget.Cells(writeRow, 7).Value = CleanCSVField(CStr(dataArray(4)))
wsTarget.Cells(writeRow, 8).Value = CleanCSVField(CStr(dataArray(5)))
wsTarget.Cells(writeRow, 9).Value = CleanCSVField(CStr(dataArray(6)))
writeRow = writeRow + 1
End If
Next i
MsgBox writeRow - 7 & " rows imported.", vbInformation
End Sub
Function CleanCSVField(ByVal field As Variant) As String
If IsEmpty(field) Or IsNull(field) Then
CleanCSVField = ""
Exit Function
Sub Z1_ExportMasterDetailData()
Dim ws As Worksheet
Dim lastDataRow As Long
Dim savePath As String
Dim csvContent As String
Dim r As Long
Dim j As Long
Dim rowCount As Long
Set ws = ActiveSheet
lastDataRow = GetLastDataRow(ws, 3)
If lastDataRow < 7 Then
MsgBox "No data rows to output.", vbExclamation
Exit Sub
End If
Dim result As String
result = Trim(CStr(field))
savePath = GetSaveCSVPath()
If savePath = "" Then Exit Sub
If Len(result) >= 2 Then
If Left(result, 1) = """" And Right(result, 1) = """" Then
result = Mid(result, 2, Len(result) - 2)
result = Replace(result, """""", """")
' Build header from row 5
csvContent = Trim(ws.Cells(5, 3).Value)
For j = 9 To 18
csvContent = csvContent & "," & Trim(ws.Cells(5, j).Value)
Next j
csvContent = csvContent & vbLf
' Build data rows
rowCount = 0
For r = 7 To lastDataRow
If Len(Trim(ws.Cells(r, 3).Value & "")) > 0 Then
rowCount = rowCount + 1
csvContent = csvContent & CleanCSVField(ws.Cells(r, 3).Value)
For j = 9 To 18
csvContent = csvContent & "," & CleanCSVField(ws.Cells(r, j).Value)
Next j
csvContent = csvContent & vbLf
End If
End If
CleanCSVField = result
End Function
Next r
' Trim trailing
Do While Right(csvContent, 1) = vbLf
csvContent = Left(csvContent, Len(csvContent) - 1)
Loop
Call WriteCSVFile(savePath, csvContent)
MsgBox "CSV export completed. Total data rows: " & rowCount, vbInformation
End Sub
Sub Z1_validateDetailData(ByVal ws As Worksheet, ByVal rowNum As Long)
' Check C column - must be 3-digit alphanumeric, required
Dim cValue As String
cValue = Trim(ws.Cells(rowNum, 3).Value)
@@ -123,35 +124,28 @@ Sub Z1_validateDetailData(ByVal ws As Worksheet, ByVal rowNum As Long)
End If
Next i
' Check D column - must be within 80 full-width characters, required
Dim dValue As String
dValue = Trim(ws.Cells(rowNum, 4).Value)
If dValue = "" Then
ws.Cells(rowNum, 2).Value = "D column is required"
Exit Sub
End If
If Len(dValue) > 80 Then
ws.Cells(rowNum, 2).Value = "D column must be within 80 characters"
Exit Sub
End If
' Check E column - must be within 80 full-width characters, required
Dim eValue As String
eValue = Trim(ws.Cells(rowNum, 5).Value)
If eValue = "" Then
ws.Cells(rowNum, 2).Value = "E column is required"
Exit Sub
End If
If Len(eValue) > 80 Then
ws.Cells(rowNum, 2).Value = "E column must be within 80 characters"
Exit Sub
End If
' Check F column - must be within 80 full-width characters, optional
Dim fValue As String
fValue = Trim(ws.Cells(rowNum, 6).Value)
If fValue <> "" And Len(fValue) > 80 Then
@@ -159,7 +153,6 @@ Sub Z1_validateDetailData(ByVal ws As Worksheet, ByVal rowNum As Long)
Exit Sub
End If
' Check G column - must be within 80 full-width characters, optional
Dim gValue As String
gValue = Trim(ws.Cells(rowNum, 7).Value)
If gValue <> "" And Len(gValue) > 80 Then
@@ -167,7 +160,6 @@ Sub Z1_validateDetailData(ByVal ws As Worksheet, ByVal rowNum As Long)
Exit Sub
End If
' Check I column - must be within 80 full-width characters, optional
Dim iValue As String
iValue = Trim(ws.Cells(rowNum, 9).Value)
If iValue <> "" And Len(iValue) > 80 Then
@@ -175,7 +167,6 @@ Sub Z1_validateDetailData(ByVal ws As Worksheet, ByVal rowNum As Long)
Exit Sub
End If
' Check H column - 1 digit, 0 or 1, optional
Dim hValue As String
hValue = Trim(ws.Cells(rowNum, 8).Value)
If hValue <> "" Then
@@ -189,12 +180,9 @@ Sub Z1_validateDetailData(ByVal ws As Worksheet, ByVal rowNum As Long)
End If
End If
' Validation passed
ws.Cells(rowNum, 2).ClearContents
End Sub
' Button macro (Validate selected row)
Sub Z1_validateDetailDataButton()
Dim ws As Worksheet
Dim lastRow As Long
@@ -202,7 +190,7 @@ Sub Z1_validateDetailDataButton()
Dim errorCount As Long
Set ws = ActiveSheet
lastRow = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row
lastRow = GetLastDataRow(ws, 3)
If lastRow < 7 Then
MsgBox "No data found.", vbExclamation
@@ -217,65 +205,5 @@ Sub Z1_validateDetailDataButton()
End If
Next r
MsgBox "Validation complete. Errors: " & errorCount & ", ", vbInformation
MsgBox "Validation complete. Errors: " & errorCount, vbInformation
End Sub
Sub Z1_ExportMasterDetailData()
Dim ws As Worksheet
Set ws = ActiveSheet
' Get last data row
Dim lastDataRow As Long
lastDataRow = GetLastDataRow(ws, 3)
If lastDataRow < 7 Then
MsgBox "No data rows to output.", vbExclamation
Exit Sub
End If
' Get save path
Dim savePath As String
savePath = GetSaveCSVPath()
If savePath = "" Then Exit Sub
' Build header from row 5
Dim csvContent As String
csvContent = Trim(ws.Cells(5, 3).Value)
Dim j As Long
For j = 9 To 18
csvContent = csvContent & "," & Trim(ws.Cells(5, j).Value)
Next j
csvContent = csvContent & vbLf
' Build data rows
Dim r As Long
For r = 7 To lastDataRow
If Len(Trim(ws.Cells(r, 3).Value & "")) > 0 Then
csvContent = csvContent & CleanCSVField(ws.Cells(r, 3).Value)
For j = 9 To 18
csvContent = csvContent & "," & CleanCSVField(ws.Cells(r, j).Value)
Next j
csvContent = csvContent & vbLf
End If
Next r
' Trim trailing
Do While Right(csvContent, 1) = vbLf
csvContent = Left(csvContent, Len(csvContent) - 1)
Loop
' Count rows
Dim rowCount As Long
rowCount = 0
Dim r As Long
For r = 7 To lastDataRow
If Len(Trim(ws.Cells(r, 3).Value & "")) > 0 Then
rowCount = rowCount + 1
End If
Next r
' Write file
Call WriteCSVFile(savePath, csvContent)
MsgBox "CSV export completed. Total data rows: " & rowCount, vbInformation
End Sub