diff --git a/vba_code_kotsu_master.txt b/vba_code_kotsu_master.txt index c879d0f..121dc3f 100644 --- a/vba_code_kotsu_master.txt +++ b/vba_code_kotsu_master.txt @@ -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 \ No newline at end of file