Add common VBA module for CSV import/export

2026-04-13 18:04:55 +09:00
parent f0d8f2895d
commit d4886e873c
1 changed files with 66 additions and 0 deletions
--- a/vba_code_common.txt
+++ b/vba_code_common.txt
@@ -0,0 +1,66 @@
+' ============================================================
+' 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