ソースコード
Option Explicit
'
' 参照設定
' Microsoft ActiveX Data Objects Access Library
'
' csvの区切り文字
' データ中に含まれないであろう1文字を採用している
Public Const NEW_SEPARATOR As String = "┻"
'
' [機能]
' csvファイル読み込み
' ファイルのデータ中にカンマを含まないことを前提とする
' [引数]
' path : csvファイルのパス
' char_code : csvファイルの文字コード
' [戻り値]
' csvのデータを格納した二次元配列
'
Public Function LoadCsv(path As String, char_code As String, column As Long) As Variant
' ファイル読み込み
Dim buf As String
Dim ado As New ADODB.Stream
With ado
.Charset = "shift_jis"
.Type = adTypeText ' テキスト形式で読みこむ。
.Open
.LoadFromFile (path)
buf = .ReadText
.Close
End With
Set ado = Nothing
' 形式変換
Dim data() As Variant
Dim lines() As String
lines = Split(buf, vbCrLf)
Dim i As Long
Dim j As Long
ReDim data(UBound(lines), column - 1)
For i = 0 To UBound(lines)
Dim items() As String
items = Split(lines(i), ",")
For j = 0 To column - 1
data(i, j) = items(j)
Next
Next
LoadCsv = data
End Function
'
' [機能]
' csvファイル読み込み
' ファイルのデータ中にカンマを含む場合でも動作する
' [引数]
' path : csvファイルのパス
' char_code : csvファイルの文字コード
' [戻り値]
' csvのデータを格納した二次元配列
'
Public Function LoadCsvSafety(path As String, char_code As String, column As Long) As Variant
' ファイル読み込み
Dim buf As String
Dim ado As New ADODB.Stream
With ado
.Charset = char_code
.Type = adTypeText ' テキスト形式で読みこむ。
.Open
.LoadFromFile (path)
buf = .ReadText
.Close
End With
Set ado = Nothing
' 形式変換
Dim data() As Variant
Dim lines() As String
lines = Split(buf, vbCrLf)
Dim i As Long
Dim j As Long
ReDim data(UBound(lines), column - 1)
For i = 0 To UBound(lines)
Dim items() As String
Dim comma_replaced_line As String
comma_replaced_line = ReplaceSeparator(lines(i), NEW_SEPARATOR)
items = Split(comma_replaced_line, NEW_SEPARATOR)
For j = 0 To column - 1
data(i, j) = items(j)
Next
Next
LoadCsvSafety = data
End Function
'
' [機能]
' csvの区切り文字をカンマから別の文字に置換する
' [引数]
' line : 1行テキスト
' new_separator : 新しい区切り文字
' [戻り値]
' new_separatorで置換された1行テキスト
'
Private Function ReplaceSeparator(line As String, new_separator As String) As String
Const QUOTE As String = """"
Const COMMA As String = ","
Dim quote_count As Long
quote_count = 0
Dim i As Long
Dim c As String
For i = 1 To Len(line)
' 1文字取得
c = Mid(line, i, 1)
If (c = QUOTE) Then
quote_count = quote_count + 1
ElseIf (c = COMMA) Then
If (quote_count Mod 2 = 0) Then
line = Left(line, i - 1) & new_separator & Right(line, Len(line) - i)
End If
End If
Next
ReplaceSeparator = line
End Function