From d3d9908d136c2c83ee59f9938a7efddc2b32b887 Mon Sep 17 00:00:00 2001 From: updsv7 Date: Mon, 13 Apr 2026 18:33:38 +0900 Subject: [PATCH] Create consolidated VBA file --- vba_all_in_one.txt | 336 +++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 336 insertions(+) create mode 100644 vba_all_in_one.txt diff --git a/vba_all_in_one.txt b/vba_all_in_one.txt new file mode 100644 index 0000000..8d4252c --- /dev/null +++ b/vba_all_in_one.txt @@ -0,0 +1,336 @@ +' ============================================================ +' 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