' ============================================================ ' Common Functions ' ============================================================ Function CleanCSVField(ByVal field As Variant) As String If IsEmpty(field) Or IsNull(field) Then CleanCSVField = "" Exit Function End If Dim result As String result = Trim(CStr(field)) If Len(result) >= 2 Then If Left(result, 1) = """" And Right(result, 1) = """" Then result = Mid(result, 2, Len(result) - 2) result = Replace(result, """""", """") End If End If CleanCSVField = result End Function Function ValidateCSVColumnCount(ByRef lines As Variant, ByVal expectedColumns As Long) As Boolean ValidateCSVColumnCount = True Dim lineNum As Long Dim dataArray As Variant Dim validRowCount As Long validRowCount = 0 For lineNum = 0 To UBound(lines) If Trim(lines(lineNum)) <> "" Then dataArray = Split(lines(lineNum), ",") If UBound(dataArray) + 1 <> expectedColumns Then MsgBox "CSV line " & (lineNum + 1) & " has " & (UBound(dataArray) + 1) & " columns. Expected " & expectedColumns & ".", vbExclamation ValidateCSVColumnCount = False Exit Function End If validRowCount = validRowCount + 1 End If Next lineNum If validRowCount = 0 Then MsgBox "No valid data in CSV.", vbExclamation ValidateCSVColumnCount = False End If End Function Function GetLastDataRow(ByVal ws As Worksheet, ByVal columnNum As Long) As Long GetLastDataRow = ws.Cells(ws.Rows.Count, columnNum).End(xlUp).Row End Function Sub ClearDataRows(ByVal ws As Worksheet, ByVal startRow As Long, ByVal columnNum As Long) Dim lastRow As Long lastRow = ws.Cells(ws.Rows.Count, columnNum).End(xlUp).Row If lastRow >= startRow Then ws.Range(ws.Cells(startRow, 1), ws.Cells(lastRow, 20)).ClearContents End If End Sub Function SelectCSVFile() As String Dim fileDialog As FileDialog Set fileDialog = Application.FileDialog(msoFileDialogFilePicker) With fileDialog .Filters.Clear .Filters.Add "CSV Files", "*.csv" .AllowMultiSelect = False If .Show <> -1 Then SelectCSVFile = "" Exit Function End If SelectCSVFile = .SelectedItems(1) End With End Function Function ReadCSVFile(ByVal filePath As String) As Variant If filePath = "" Then ReadCSVFile = Array() Exit Function End If Dim stream As Object Dim textContent As String Set stream = CreateObject("ADODB.Stream") With stream .Type = 2 .Charset = "shift_jis" .Open .LoadFromFile filePath textContent = .ReadText .Close End With ReadCSVFile = Split(textContent, vbLf) End Function Function GetSaveCSVPath(Optional ByVal defaultName As String = "") As String Dim savePath As String savePath = Application.GetSaveAsFilename( _ FileFilter:="CSV Files (*.csv), *.csv", _ Title:="Save CSV", _ InitialFileName:=defaultName) If savePath = "False" Or savePath = "" Then GetSaveCSVPath = "" Exit Function End If If InStr(1, savePath, ".csv", vbTextCompare) = 0 Then savePath = savePath & ".csv" End If GetSaveCSVPath = savePath End Function Sub WriteCSVFile(ByVal filePath As String, ByVal content As String) Dim stream As Object Set stream = CreateObject("ADODB.Stream") With stream .Type = 2 .Charset = "shift_jis" .Open .WriteText content, 1 .SaveToFile filePath, 2 .Close End With End Sub ' ============================================================ ' Z1 Specific Functions ' ============================================================ Sub Z1_ClearRowData(ByVal ws As Worksheet, ByVal rowNum As Long) ws.Range(ws.Cells(rowNum, 4), ws.Cells(rowNum, 15)).ClearContents ws.Cells(rowNum, 2).ClearContents End Sub Sub Z1_ImportMasterDetailData() Dim filePath As String Dim wsTarget As Worksheet Dim lines As Variant Dim i As Long Dim dataArray As Variant Dim writeRow As Long Set wsTarget = Me filePath = SelectCSVFile() If filePath = "" Then Exit Sub lines = ReadCSVFile(filePath) If Not ValidateCSVColumnCount(lines, 7) Then Exit Sub Call ClearDataRows(wsTarget, 7, 3) writeRow = 7 For i = 0 To UBound(lines) 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 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 savePath = GetSaveCSVPath() If savePath = "" Then Exit Sub 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 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 Next r 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) Dim cValue As String cValue = Trim(ws.Cells(rowNum, 3).Value) If cValue = "" Then ws.Cells(rowNum, 2).Value = "C column is required" Exit Sub End If If Len(cValue) <> 3 Then ws.Cells(rowNum, 2).Value = "C column must be 3 characters" 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" 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" 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 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 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" Exit Sub End If Dim gValue As String gValue = Trim(ws.Cells(rowNum, 7).Value) If gValue <> "" And Len(gValue) > 80 Then ws.Cells(rowNum, 2).Value = "G column must be within 80 characters" Exit Sub End If Dim iValue As String iValue = Trim(ws.Cells(rowNum, 9).Value) If iValue <> "" And Len(iValue) > 80 Then ws.Cells(rowNum, 2).Value = "I column must be within 80 characters" Exit Sub End If Dim hValue As String hValue = Trim(ws.Cells(rowNum, 8).Value) If hValue <> "" Then If Len(hValue) <> 1 Then ws.Cells(rowNum, 2).Value = "H column must be 1 digit" Exit Sub End If If hValue <> "0" And hValue <> "1" Then ws.Cells(rowNum, 2).Value = "H column must be 0 or 1" Exit Sub End If End If ws.Cells(rowNum, 2).ClearContents End Sub Sub Z1_validateDetailDataButton() Dim ws As Worksheet Dim lastRow As Long Dim r As Long Dim errorCount As Long Set ws = ActiveSheet lastRow = GetLastDataRow(ws, 3) If lastRow < 7 Then MsgBox "No data found.", vbExclamation Exit Sub End If errorCount = 0 For r = 7 To lastRow Call Z1_validateDetailData(ws, r) If Trim(ws.Cells(r, 2).Value) <> "" Then errorCount = errorCount + 1 End If Next r MsgBox "Validation complete. Errors: " & errorCount, vbInformation End Sub