ラブびあ

ビール。ときどきラブ

CSVファイル入出力補助関数

CSVファイルを読み書きする補助関数として、一行分のCSV文字列をカンマで配列に分割するSplitCSV関数と、配列をCSV文字列に結合するJoinCSV関数を作りました。いちおう括り文字と前ゼロを考慮しています。

Option Explicit

Const vbDoubleQuote$ = """"
Const vbComma$ = ","

Private Sub Command1_Click()
    Dim i     As Long
    Dim arr() As String
    Dim f     As Integer
    Dim line  As String
    
    f = FreeFile
    Open "C:\Documents and Settings\love4beer\デスクトップ\test.csv" For Input As #f
    Do Until EOF(f)
        Line Input #f, line
        
        Debug.Print "line:" & line

        arr = SplitCSV(line)
        For i = LBound(arr) To UBound(arr)
            Debug.Print i & ":" & arr(i)
        Next
    
        Debug.Print "join:" & JoinCSV(arr)
    Loop
    Close #f
End Sub

Function SplitCSV(line As String) As String()
    Dim i      As Long
    Dim quoted As Boolean 'ダブルクォートの内側のときTrue/それ以外のときFalse
    Dim arr()  As String
    
    quoted = False
    
    '区切文字のカンマをバックスペース(CSVファイルに入力できない値)に置換する
    For i = 1 To Len(line)
        Select Case Mid$(line, i, 1)
        Case vbDoubleQuote
            quoted = Not quoted
        Case vbComma
            If Not quoted Then
                Mid$(line, i, 1) = vbBack
            End If
        End Select
    Next

    'バックスペースでSplit
    arr = Split(line, vbBack)
    
    For i = LBound(arr) To UBound(arr)
        '括り文字を外す(一旦タブに置換して、後でまとめて削除する)
        If arr(i) Like vbDoubleQuote & "*" & vbDoubleQuote Then
           Mid$(arr(i), 1, 1) = vbTab
           Mid$(arr(i), Len(arr(i)), 1) = vbTab
        End If
    
        'Trim、エスケープを元に戻す、タブを削除する
        arr(i) = Replace$(Replace$( _
                    Trim$(arr(i)), _
                    vbDoubleQuote & vbDoubleQuote, vbDoubleQuote), _
                    vbTab, vbNullString)
    Next
    
    Let SplitCSV = arr
End Function

Function JoinCSV(arr() As String) As String
    Dim i As Long
    For i = LBound(arr) To UBound(arr)
        'ダブルクォートで括る(データ中のダブルクォートをエスケープする)
        '前ゼロコードにはタブを付加する
        arr(i) = vbDoubleQuote & _
                 IIf(IsNumeric(arr(i)) And arr(i) Like "0#*", vbTab, vbNullString) & _
                 Replace$(arr(i), vbDoubleQuote, vbDoubleQuote & vbDoubleQuote) & _
                 vbDoubleQuote
    Next
    
    Let JoinCSV = Join(arr, vbComma)
End Function


■追記■
SplitCSV関数を、ExcelCSV解析に準拠させてみました。最初のForループで、括りとエスケープのダブルクォートをvbTabに、区切りのカンマをvbBackに置換し、その後、Replaceでタブを除去して、Splitで配列に分割しています。

Enum FindState
    FindOpen
    FindClose
    FindComma
End Enum

Function SplitCSV(ByVal line As String) As String()
    Dim i   As Long
    Dim fs  As FindState
    
    fs = FindState.FindOpen
    
    For i = 1 To Len(line)
        Select Case fs
        Case FindState.FindOpen
        '項目の先頭で括りの開始を探す
            Select Case Mid$(line, i, 1)
            Case vbDoubleQuote
                Mid$(line, i, 1) = vbTab
                fs = FindState.FindClose
            Case vbComma '値なしの項目
                Mid$(line, i, 1) = vbBack
            Case Else
                fs = FindState.FindComma
            End Select
        
        Case FindState.FindClose
        '括りの内側である場合に限り括りの終了を探す
            If Mid$(line, i, 1) = vbDoubleQuote Then
                Mid$(line, i, 1) = vbTab
                '次の文字をチェックする
                If Mid$(line, i + 1, 1) = vbDoubleQuote Then
                    'エスケープされたダブルクォートはスキップする
                    i = i + 1
                Else
                    '単独のダブルクォートなので括りの終了
                    fs = FindState.FindComma
                End If
            End If
        
        Case FindState.FindComma
        '括りの内側でない場合に限りカンマを探す
            If Mid$(line, i, 1) = vbComma Then
                Mid$(line, i, 1) = vbBack
                fs = FindState.FindOpen
            End If
        End Select
    Next
    
    Let SplitCSV = Split(Replace$(line, vbTab, vbNullString), vbBack)
End Function