modify ReadCSVAs2DArrayStrict

vba_code_common.bas

@@ -2,49 +2,20 @@
 ' Common Functions
 ' ============================================================
 
-Function CleanCSVField(ByVal field As Variant) As String
+Function CleanCSVField(ByVal inputStr As String) As String
-    If IsEmpty(field) Or IsNull(field) Then
+    Dim s As String
-        CleanCSVField = ""
+    s = Trim(inputStr)
-        Exit Function
-    End If
     
-    Dim result As String
+    ' calcute
-    result = Trim(CStr(field))
+    If Len(s) > 0 Then
-    
+        Select Case Left(s, 1)
-    If Len(result) >= 2 Then
+            Case "=", "+", "-", "@"
-        If Left(result, 1) = """" And Right(result, 1) = """" Then
+                CleanCSVField = "'" & s
-            result = Mid(result, 2, Len(result) - 2)
-            result = Replace(result, """""", """")
-        End If
-    End If
-    
-    CleanCSVField = result
-End Function
-
-Function ValidateCSVColumnCount(ByVal 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
+        End Select
-            validRowCount = validRowCount + 1
-        End If
-    Next lineNum
-    
-    If validRowCount = 0 Then
-        MsgBox "No valid data in CSV.", vbExclamation
-        ValidateCSVColumnCount = False
     End If
+    
+    CleanCSVField = s
 End Function
 
 Function GetLastDataRow(ByVal ws As Worksheet, ByVal columnNum As Long) As Long
@@ -109,141 +80,101 @@ Sub WriteCSVFile(ByVal filePath As String, ByVal content As String)
     End With
 End Sub
 
-
-Function ReadCSVFile(ByVal filePath As String, Optional ByVal charset As String = "shift_jis") 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 = charset
-        .Open
-        .LoadFromFile filePath
-        textContent = .ReadText
-        .Close
-    End With
-    
-    ReadCSVFile = Split(textContent, vbLf)
-End Function
-
 ' Read a CSV file and return its content as a strict 2D array (1-based).
-' The function ensures all rows have the same number of columns as the first row.
+' All rows must have the same number of columns as the first row.
-' If any row has a different column count, an error is raised immediately.
+' If the file is empty and defaultColumnCount > 0, returns an empty 2D array with zero rows and defaultColumnCount columns.
 ' Parameters:
-'   filePath: Full path to the CSV file.
+'   filePath:           Full path to the CSV file.
-'   charset:  Text encoding (e.g., "cp932" for Shift-JIS, "utf-8" for UTF-8).
+'   charset:            Text encoding (e.g., "cp932", "utf-8").
-Function ReadCSVAs2DArrayStrict(ByVal filePath As String, Optional ByVal charset As String = "cp932") As Variant
+'   defaultColumnCount: Optional. Used only if CSV has no rows. Must be >= 0.
-    ' Check if file exists
+Function ReadCSVAs2DArrayStrict( _
-    If filePath = "" Or Dir(filePath) = "" Then
+    ByVal filePath As String, _
-        Err.Raise vbObjectError + 1001, , "File not found: " & filePath
+    ByVal expectedColumnCount As Long, _
+    Optional ByVal charset As String = "cp932", _
+    Optional ByVal hasHeader As Boolean = False) As Variant
+
+    ' === validate expectedColumnCount ===
+    If expectedColumnCount <= 0 Then
+        Err.Raise 5001, , "expectedColumnCount must be >= 1."
     End If
     
-    ' Read entire file using ADODB.Stream with specified character set
+    If Dir(filePath) = "" Then
+        Err.Raise 5002, , "File not found: " & filePath
+    End If
+
+    ' === read csv file ===
     Dim stream As Object
     Set stream = CreateObject("ADODB.Stream")
     With stream
         .Type = 2 ' adTypeText
-        .Charset = charset
+        .charset = charset
         .Open
         .LoadFromFile filePath
         Dim textContent As String
         textContent = .ReadText
         .Close
     End With
-    
+
-    ' Handle empty file
+    ' === stardand ===
-    If textContent = "" Then
-        Err.Raise vbObjectError + 1002, , "CSV file is empty"
-    End If
-    
-    ' Normalize line breaks to vbLf (\n)
     textContent = Replace(textContent, vbCrLf, vbLf)
     textContent = Replace(textContent, vbCr, vbLf)
-    
+
-    ' Parse CSV lines into a collection of string arrays
+    ' === transfer into collection ===
     Dim lines As Collection
     Set lines = ParseCSVLines(textContent)
-    
+
+    ' === validate empty ===
     If lines.Count = 0 Then
-        Err.Raise vbObjectError + 1003, , "No valid rows parsed from CSV"
+        Err.Raise 5003, , "CSV file is empty."
     End If
-    
+
-    ' Determine expected column count from the first row
+    ' === loop the row, validate column count ===
-    Dim expectedCols As Long
-    Dim firstRow As Variant
-    firstRow = lines(1)
-    expectedCols = UBound(firstRow) - LBound(firstRow) + 1
-    
-    If expectedCols <= 0 Then
-        Err.Raise vbObjectError + 1004, , "First row contains no fields"
-    End If
-    
-    ' Validate every row has exactly expectedCols columns
     Dim i As Long
     For i = 1 To lines.Count
-        Dim currentRow As Variant
+        Dim rowArr As Variant
-        currentRow = lines(i)
+        rowArr = lines(i)
         Dim actualCols As Long
-        actualCols = UBound(currentRow) - LBound(currentRow) + 1
+        actualCols = UBound(rowArr) - LBound(rowArr) + 1
         
-        If actualCols <> expectedCols Then
+        If actualCols <> expectedColumnCount Then
-            Err.Raise vbObjectError + 1005, , _
+            Err.Raise 5004, , "Row " & i & ": Expected " & expectedColumnCount & " columns, got " & actualCols & "."
-                "CSV row column count mismatch!" & vbCrLf & _
-                "Expected columns: " & expectedCols & vbCrLf & _
-                "Row " & i & " has " & actualCols & " columns."
         End If
     Next i
-    
+
-    ' Build 1-based 2D result array (no padding needed due to strict validation)
     Dim result As Variant
-    ReDim result(1 To lines.Count, 1 To expectedCols)
+    ReDim result(1 To lines.Count, 1 To expectedColumnCount)
     
     For i = 1 To lines.Count
-        currentRow = lines(i)
+        rowArr = lines(i)
         Dim j As Long
-        For j = LBound(currentRow) To UBound(currentRow)
+        For j = LBound(rowArr) To UBound(rowArr)
-            result(i, j - LBound(currentRow) + 1) = currentRow(j)
+            result(i, j - LBound(rowArr) + 1) = rowArr(j)
         Next j
     Next i
-    
+
     ReadCSVAs2DArrayStrict = result
 End Function
 
-' Parse CSV text into a Collection of string arrays, respecting RFC 4180 rules.
+' Helper function: Parse CSV text into collection of string arrays (zero-based per row)
-' Handles quoted fields, commas/line breaks inside quotes, and escaped quotes ("").
-' Input: CSV text with normalized line endings (vbLf only).
-' Output: Collection where each item is a zero-based array of field strings.
 Private Function ParseCSVLines(ByVal csvText As String) As Collection
     Set ParseCSVLines = New Collection
-    
+    Dim length As Long: length = Len(csvText)
-    Dim length As Long
-    length = Len(csvText)
     If length = 0 Then Exit Function
     
-    Dim i As Long
+    Dim i As Long: i = 1
-    i = 1
     Dim currentField As String
-    Dim currentRow As Collection
+    Dim currentRow As Collection: Set currentRow = New Collection
-    Set currentRow = New Collection
     Dim inQuotes As Boolean
     Dim c As String
     
     Do While i <= length
         c = Mid$(csvText, i, 1)
-        
         Select Case c
             Case """"
                 If inQuotes Then
-                    ' Check for escaped quote ("")
                     If i < length And Mid$(csvText, i + 1, 1) = """" Then
                         currentField = currentField & """"
-                        i = i + 2 ' Skip both quotes
+                        i = i + 2
                     Else
                         inQuotes = False
                         i = i + 1
@@ -252,26 +183,21 @@ Private Function ParseCSVLines(ByVal csvText As String) As Collection
                     inQuotes = True
                     i = i + 1
                 End If
-                
             Case ","
                 If inQuotes Then
                     currentField = currentField & c
                     i = i + 1
                 Else
-                    ' End of field
                     currentRow.Add currentField
                     currentField = ""
                     i = i + 1
                 End If
-                
             Case vbLf
                 If inQuotes Then
                     currentField = currentField & c
                     i = i + 1
                 Else
-                    ' End of row
                     currentRow.Add currentField
-                    ' Convert collection to array
                     Dim arr() As String
                     If currentRow.Count > 0 Then
                         ReDim arr(0 To currentRow.Count - 1)
@@ -281,20 +207,18 @@ Private Function ParseCSVLines(ByVal csvText As String) As Collection
                         Next k
                     End If
                     ParseCSVLines.Add arr
-                    ' Reset for next row
                     Set currentRow = New Collection
                     currentField = ""
                     inQuotes = False
                     i = i + 1
                 End If
-                
             Case Else
                 currentField = currentField & c
                 i = i + 1
         End Select
     Loop
     
-    ' Handle last row if file doesn't end with newline
+    ' Handle last row without trailing newline
     If currentField <> "" Or currentRow.Count > 0 Then
         currentRow.Add currentField
         Dim lastArr() As String

vba_code_kotsu_master.bas

@@ -13,40 +13,40 @@ Sub Z1_ImportMasterDetailData()
     Dim writeRow As Long
     
     Set wsTarget = Me
+    On Error GoTo ErrorHandler
     
     ' Step 1: Select CSV file
     filePath = SelectCSVFile()
     If filePath = "" Then Exit Sub
     
-    ' Step 2: Read CSV
+    ' Step 2: Read CSV and return 2D array
-    lines = ReadCSVFile(filePath, "utf-8")
+    lines = ReadCSVAs2DArrayStrict(filePath, 7, "utf-8")
     
-    ' Step 3: Validate column count
+    ' Step 3: Clear data rows
-    If Not ValidateCSVColumnCount(lines, 7) Then Exit Sub
-    
-    ' Step 4: Clear data rows
     Call ClearDataRows(wsTarget, 7, 3)
     
-    ' Step 5: Import data
+    ' Step 4: Import data
     writeRow = 7
-    
+    For i = LBound(lines, 1) To UBound(lines, 1)
-    For i = 0 To UBound(lines)
+        If Not isRowEmpty Then
-        If Trim(lines(i)) <> "" Then
+            wsTarget.Cells(writeRow, 3).Value = CleanCSVField(CStr(lines(i, 1)))
-            dataArray = Split(lines(i), ",")
+            wsTarget.Cells(writeRow, 4).Value = CleanCSVField(CStr(lines(i, 2)))
-            
+            wsTarget.Cells(writeRow, 5).Value = CleanCSVField(CStr(lines(i, 3)))
-            wsTarget.Cells(writeRow, 3).Value = CleanCSVField(CStr(dataArray(0)))
+            wsTarget.Cells(writeRow, 6).Value = CleanCSVField(CStr(lines(i, 4)))
-            wsTarget.Cells(writeRow, 4).Value = CleanCSVField(CStr(dataArray(1)))
+            wsTarget.Cells(writeRow, 7).Value = CleanCSVField(CStr(lines(i, 5)))
-            wsTarget.Cells(writeRow, 5).Value = CleanCSVField(CStr(dataArray(2)))
+            wsTarget.Cells(writeRow, 8).Value = CleanCSVField(CStr(lines(i, 6)))
-            wsTarget.Cells(writeRow, 6).Value = CleanCSVField(CStr(dataArray(3)))
+            wsTarget.Cells(writeRow, 9).Value = CleanCSVField(CStr(lines(i, 7)))
-            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
+    
+    Exit Sub
+
+ErrorHandler:
+    MsgBox "Import fails:" & vbCrLf & Err.Description, vbCritical
 End Sub
 
 Sub Z1_ExportMasterDetailData()