カンマや改行のあるCSVのパース

RFC4180準拠 のCSVパーサ

Twitterで以下のような発言を見かけた。

おっ、ちょうど RFC4180準拠( http://www.kasai.fm/wiki/rfc4180jp )のCSVパーサを作ったところだったので公開します。

返却される値はCollecitonの中にCollectionがネストした形になります。

固有のクラス(StringBuilderやCharCursor)を使用しているのはご容赦。一番したのURLから全体のソースをご確認ください。

'--------------------------------------------------------------
' CSVパーサー RFC4180準拠
' コーテーションの有無, デリミタ指定あり
'--------------------------------------------------------------
Public Function CsvParser(ByVal strBuf As String, Optional ByVal Quatation As Boolean = False, Optional ByVal Delimiter As String = ",") As Collection

    Const C_QUAT As String = """"
    Dim IC As ICursor
    Dim sw As Boolean
    Dim blnLineBreak As Boolean
    Dim blnItemBreak As Boolean
    Dim Col As Collection
    Dim Row As Collection
    Dim lngQuot As Long
    
    lngQuot = 0
    
    sw = False
    
    Set Row = New Collection
    
    Set IC = Constructor(New CharCursor, strBuf)
    Do Until IC.Eof
        
        '初期化
        Set Col = New Collection
        blnLineBreak = False

        Do Until IC.Eof Or blnLineBreak
        
            '初期化
            Dim SB As StringBuilder
            Set SB = New StringBuilder
            blnItemBreak = False
            
            Do Until IC.Eof Or blnLineBreak Or blnItemBreak

                Select Case IC.Item
                    Case C_QUAT

                        'コーテーションありの場合
                        If Quatation Then

                            lngQuot = lngQuot + 1

                            If sw Then

                                '次の文字がQuatation
                                If IC.Item(1) = C_QUAT Then
                                    lngQuot = lngQuot + 1
                                    SB.Append C_QUAT
                                    IC.MoveNext
                                Else
                                    sw = False
                                End If

                            Else
                                sw = True
                            End If
                        End If

                    Case vbCr

                        If sw Then
                            SB.Append IC.Item
                        End If

                    Case vbLf

                        If sw Then
                            SB.Append IC.Item
                        Else
                            blnLineBreak = True
                        End If

                    Case Delimiter

                        If sw Then
                            SB.Append IC.Item
                        Else
                            blnItemBreak = True
                        End If

                    Case Else

                        SB.Append IC.Item

                End Select
            
                IC.MoveNext
            Loop
            
            '列追加処理
            Col.Add SB.ToString
            
        Loop
        
        '行追加処理
        Row.Add Col
        
    Loop
    
    'ダブルコーテーションが偶数ではない場合
    If lngQuot Mod 2 <> 0 Then
        Message.Throw 1, Me, "CsvParser", "Invalid Format(Quotation)"
    End If
    
    Set CsvParser = Row
    
End Function

呼び出し方サンプル

Sub CsvParser_Sample()

    Dim strBuf As String
    Dim Row As Collection
    Dim Col As Collection
    Dim v As Variant
    strBuf = "1, Watanabe, Fukushima, 36, ""カンマがあっても,OK""" & vbCrLf & "2, satoh, chiba, 24, ""改行があっても" & vbLf & "OKやで"""

    Set Row = StringHelper.CsvParser(strBuf, True)

    For Each Col In Row
        For Each v In Col
            Debug.Print v
        Next
    Next

End Sub

イミディエイトウィンドウ

1
 Watanabe
 Fukushima
 36
 カンマがあっても,OK
2
 satoh
 chiba
 24
 改行があっても
OKやで

全体のソースはGithubにて公開しています。

Hidennotare v1

https://github.com/RelaxTools/Hidennotare/blob/master/src/StringHelper.cls