更新 vba_code_common.bas

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