読者です 読者をやめる 読者になる 読者になる

アナログCPU:5108843109

ゲームと音楽とプログラミング(酒と女とロックンロールのノリで)

CSVを読み込み二次元配列に格納するプロシージャ・改

前にも同じようなのを作って使っていたんですが、
CSVにカンマや改行が含まれていると機能しないとかいうクソっぷりだったので、
大幅に改修しました。
あと、UTF-8CSVに対応したい事案があったのでそれも合わせて。
(改修というか別物に近い)


参考: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)