CSVを読み込み二次元配列に格納するプロシージャ・改
前にも同じようなのを作って使っていたんですが、
CSVにカンマや改行が含まれていると機能しないとかいうクソっぷりだったので、
大幅に改修しました。
あと、UTF-8のCSVに対応したい事案があったのでそれも合わせて。
(改修というか別物に近い)
参考:UTF-8形式のテキストファイルから読み込む - Office TANAKA
http://officetanaka.net/excel/vba/file/file10.htm
参考:CSVの読み込み方法 - エクセルの神髄
http://excel-ubara.com/excelvba5/EXCEL111.html
途中、改行コードを調整している箇所がありますので、環境によって適切な感じに書き変えてください。
(詳しい解説は記事末尾に)
さて、以下がプロシージャですが
使う前に、VBEの ツール>参照設定 にて
「Microsoft ActiveX Data Objects」を探してチェックを入れておきます。
バージョンは一番新しいものでOKでしょう。
'* '* CSVを読み込み二次元配列に格納 '* '* in sCsvFile CSVファイルまでのフルパス '* sCharset 文字コード(Shift_JIS, UTF-8, ...) '* out CsvRead() CSVの中身(二次元配列) '* Public Function CsvRead(ByVal sCsvFile As String, Optional ByVal sCharset As String = "Shift_JIS") As String() Dim lDatNum As Long Dim sTmp As String Dim sTmpDat As String Dim sLine() As String Dim sRet() As String Dim lQuoteCount As Long Dim i As Long Dim j As Long Dim k As Long Dim streamAdodb As ADODB.stream 'ファイルの存在を調べる If Not CreateObject("Scripting.FileSystemObject").FileExists(sCsvFile) Then Exit Function End If 'ADODB.Stream生成 Set streamAdodb = New ADODB.stream With streamAdodb 'テキストモード、文字コードセット .Type = adTypeText .Charset = sCharset 'Streamオープン .Open 'ファイル読み込み .LoadFromFile (sCsvFile) sTmp = .ReadText 'Streamクローズ .Close End With Set streamAdodb = Nothing '改行コードの調整&一行ごとに配列に移す sTmp = Replace(sTmp, vbCrLf, vbCr) sLine = Split(sTmp, vbLf) 'データ数を求める(最後の行が空行の場合はカウントしない) If sLine(UBound(sLine)) = "" Then lDatNum = UBound(sLine) Else lDatNum = UBound(sLine) + 1 End If '戻り値の枠をつくる ReDim sRet(0 To lDatNum - 1, 0 To 0) '一行ごとに処理 For i = 0 To lDatNum - 1 ' さっき調整した改行を元に戻す sLine(i) = Replace(sLine(i), vbCr, vbCrLf) j = 0 lQuoteCount = 0 sTmpDat = "" For k = 1 To Len(sLine(i)) Select Case Mid(sLine(i), k, 1) Case "," '「"」が偶数なら区切り、奇数ならただの文字 If lQuoteCount Mod 2 = 0 Then If UBound(sRet, 2) < j + 1 Then ReDim Preserve sRet(0 To lDatNum - 1, 0 To j) End If sRet(i, j) = adjustQuote(sTmpDat) j = j + 1 lQuoteCount = 0 sTmpDat = "" Else sTmpDat = sTmpDat & Mid(sLine(i), k, 1) End If Case """" '「"」のカウントをとる lQuoteCount = lQuoteCount + 1 sTmpDat = sTmpDat & Mid(sLine(i), k, 1) Case Else sTmpDat = sTmpDat & Mid(sLine(i), k, 1) End Select Next '最終列の処理 If UBound(sRet, 2) < j Then ReDim Preserve sRet(0 To lDatNum - 1, 0 To j) End If sRet(i, j) = adjustQuote(sTmpDat) j = j + 1 lQuoteCount = 0 sTmpDat = "" Next CsvRead = sRet End Function Private Function adjustQuote(ByVal strTmpDat As String) '「""」のみであれば空にする If strTmpDat = """""" Then strTmpDat = "" End If '「""」を「"」で置換 strTmpDat = Replace(strTmpDat, """""", """") '前後の「"」を削除 If Left(strTmpDat, 1) = """" And Right(strTmpDat, 1) = """" And Len(strTmpDat) >= 2 Then strTmpDat = Mid(strTmpDat, 2, Len(strTmpDat) - 2) End If adjustQuote = strTmpDat End Function
改行コードの調整について。
ここでは、CSVのレコードごとの改行が「LF」、レコード内に含まれる改行が「CRLF」だったので、
- CRLFをCRに置換してからLFごとに区切ってレコードとする
- 区切った後のレコードについて、CRをCRLFに置換し直す
というステップを踏んでいます。
必要に応じて調整してください。
(両方とも同じ改行コードとかだと困る…)
'<抜粋>改行コードの調整&一行ごとに配列に移す sTmp = Replace(sTmp, vbCrLf, vbCr) '<抜粋>さっき調整した改行を元に戻す sLine(i) = Replace(sLine(i), vbCr, vbCrLf)