diff --git a/vba_code_z1.bas b/vba_code_z1.bas deleted file mode 100644 index 84eee91..0000000 --- a/vba_code_z1.bas +++ /dev/null @@ -1,360 +0,0 @@ -' ============================================================ -' Common VBA Functions for CSV Import/Export -' ============================================================ - -' Clean CSV field - remove quotes and trim -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 - -' 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 - - 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 - -' 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 - - If lastRow >= startRow Then - ws.Range(ws.Cells(startRow, 1), ws.Cells(lastRow, 20)).ClearContents - 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) - - 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 - -' ============================================================ -' Read CSV file with Shift-JIS encoding -' Returns: array of lines -' ============================================================ -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 - -' ============================================================ -' 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( _ - 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 - -' ============================================================ -' 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") - With stream - .Type = 2 - .Charset = "shift_jis" - .Open - .WriteText content, 1 - .SaveToFile filePath, 2 - .Close - End With -End Sub -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 code As String - Dim writeRow As Long - - Set wsTarget = Me - - ' Step 1: Select CSV file - filePath = SelectCSVFile() - If filePath = "" Then Exit Sub - - ' Step 2: Read CSV - lines = ReadCSVFile(filePath) - - ' Step 3: Validate column count - If Not ValidateCSVColumnCount(lines, 7) Then Exit Sub - - ' Step 4: Clear data rows - Call ClearDataRows(wsTarget, 7, 3) - - ' Step 5: Import data - 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 - - ' 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 - 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) - 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