diff --git a/vba_code_common.bas b/vba_code_common.bas index 767d994..8d4252c 100644 --- a/vba_code_common.bas +++ b/vba_code_common.bas @@ -1,8 +1,7 @@ ' ============================================================ -' Common VBA Functions for CSV Import/Export +' Common Functions ' ============================================================ -' Clean CSV field - remove quotes and trim Function CleanCSVField(ByVal field As Variant) As String If IsEmpty(field) Or IsNull(field) Then CleanCSVField = "" @@ -22,8 +21,6 @@ Function CleanCSVField(ByVal field As Variant) As String CleanCSVField = result End Function -' Validate CSV column count for all data rows -' Returns: True if valid, False if any row has wrong column count Function ValidateCSVColumnCount(ByRef lines As Variant, ByVal expectedColumns As Long) As Boolean ValidateCSVColumnCount = True @@ -50,12 +47,10 @@ Function ValidateCSVColumnCount(ByRef lines As Variant, ByVal expectedColumns As End If End Function -' Get last data row in worksheet Function GetLastDataRow(ByVal ws As Worksheet, ByVal columnNum As Long) As Long GetLastDataRow = ws.Cells(ws.Rows.Count, columnNum).End(xlUp).Row End Function -' Clear data rows from row 7 onwards 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 @@ -65,10 +60,6 @@ Sub ClearDataRows(ByVal ws As Worksheet, ByVal startRow As Long, ByVal columnNum End If End Sub -' ============================================================ -' File Dialog - Select CSV file -' Returns: file path or "" if cancelled -' ============================================================ Function SelectCSVFile() As String Dim fileDialog As FileDialog Set fileDialog = Application.FileDialog(msoFileDialogFilePicker) @@ -85,10 +76,6 @@ Function SelectCSVFile() As String End With End Function -' ============================================================ -' Read CSV file with Shift-JIS encoding -' Returns: array of lines -' ============================================================ Function ReadCSVFile(ByVal filePath As String) As Variant If filePath = "" Then ReadCSVFile = Array() @@ -111,10 +98,6 @@ Function ReadCSVFile(ByVal filePath As String) As Variant ReadCSVFile = Split(textContent, vbLf) End Function -' ============================================================ -' Get save file path for CSV -' Returns: file path or "" if cancelled -' ============================================================ Function GetSaveCSVPath(Optional ByVal defaultName As String = "") As String Dim savePath As String savePath = Application.GetSaveAsFilename( _ @@ -134,9 +117,6 @@ Function GetSaveCSVPath(Optional ByVal defaultName As String = "") As String GetSaveCSVPath = savePath End Function -' ============================================================ -' Write content to CSV file with Shift-JIS encoding -' ============================================================ Sub WriteCSVFile(ByVal filePath As String, ByVal content As String) Dim stream As Object Set stream = CreateObject("ADODB.Stream") @@ -149,3 +129,208 @@ Sub WriteCSVFile(ByVal filePath As String, ByVal content As String) .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