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関数を、ExcelのCSV解析に準拠させてみました。最初の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