vbaでcsvを一気にScripting.Dictionaryに格納する方法、セル内改行やダブルクォーテーションエスケープ対応版

vbaでcsvを読み込む方法が2つあると思う

一つ目：
テキストとして一行つづ読んで、区切りコンマまたはタブでsplitして処理する、この方法はメリットは高速で簡単、デメリットはフィルド内改行やダブルクォーテーションがあったら、おかしくなること

二つ目：
Workbookでcsvを開き、range単位で処理する方法。方法１と比べてちょっと遅いですが、Excelで正常に開けるCSVなら、問題なく処理できるというのはポイント。※注意：連想配列Scripting.Dictionaryを使うには、「ツール」⇒「参考設定」の中に「Microsoft Scripting Runtime」をチェック入れてね

それでは2番目の方法を紹介します：

例えばこんなCSVがあります

名前	学校名	学年	クラス	国語	英語	数学
田中	一小	3年	1組	90	80	70
佐藤	ニ小	3年	1組	34	60	90
渡辺	一小	2年	2組	78	76	80
田中	ニ小	1年	3組	66	66	78
中田	一小	2年	1組	67	89	53
山田	ニ小	3年	2組	43	57	78

まずは一個モジュールを作りましょう。例えば名前はcsv_reader。内容は下記：

Option Explicit
Public gReits As New Scripting.Dictionary '格納先の連想配列
Sub CSV_Read2()
    Dim FileType, Prompt As String
    Dim FileNamePath As Variant
    Dim dicHeader As New Scripting.Dictionary
    Dim dicHeaderRev As New Scripting.Dictionary
    Dim wb As New Workbook
    Dim st As New Worksheet
    Dim csvrow As Range
    Dim csvfield As Range
    Dim strFolder As String
    
    Dim FSO As Object
    
    'まずはcsvファイルを選択するダイアログボックス
    FileType = "CSV ﾌｧｲﾙ (*.csv),*.csv"
    Prompt = "CSV File を選択してください"
    
    '操作したいファイルのパスを取得します
    FileNamePath = SelectFileNamePath(FileType, Prompt)

    'キャンセルボタンが押された
    If FileNamePath = False Then
        End
    End If
    
    '格納先の連想配列を空にする
    gReits.RemoveAll
    
    'csvファイルを開く
    Set wb = Workbooks.Open(FileNamePath)
    'シートをセット（csvファイルはsheet1しかない）
    Set st = wb.Sheets(1)
    '内容の有るすべてのレンジから一行つづ読み込む
    For Each csvrow In st.UsedRange.Rows
        '一行目はタイトル、タイトル変数に格納
        If csvrow.row = 1 Then
            'タイトル行のすべての列
            For Each csvfield In csvrow.Columns
                'タイトル名と列の情報をkey,item交代でそれそれ格納し
                dicHeader.Add csvfield.Value, csvfield.Column
                dicHeaderRev.Add csvfield.Column, csvfield.Value
            Next
        Else
            '2行目以降の処理
            '今後使うときにやりやすいようにデータは階層構造として格納する
            '第一階層キーはcsvの学校の値
            '第二階層キーは学年
            '第三階層キーはクラス
            '第四階層キーはなく、csvの生徒のデータを格納する場所
            
            'もし第一階層キーまだ登録してなければ登録します
            If Not gReits.Exists(Cells(csvrow.row, dicHeader.Item("学校名")).Value) Then
                gReits.Add Cells(csvrow.row, dicHeader.Item("学校名")).Value, New Scripting.Dictionary
            End If
            
            'もし第ニ階層キーまだ登録してなければ登録します
            If Not gReits.Item(Cells(csvrow.row, dicHeader.Item("学校名")).Value).Exists(Cells(csvrow.row, dicHeader.Item("学年")).Value) Then
                gReits.Item(Cells(csvrow.row, dicHeader.Item("学校名")).Value).Add Cells(csvrow.row, dicHeader.Item("学年")).Value, New Scripting.Dictionary
            End If
            
            'もし第三階層キーまだ登録してなければ登録します
            If Not gReits.Item(Cells(csvrow.row, dicHeader.Item("学校名")).Value).Item(Cells(csvrow.row, dicHeader.Item("学年")).Value).Exists(Cells(csvrow.row, dicHeader.Item("クラス")).Value) Then
                gReits.Item(Cells(csvrow.row, dicHeader.Item("学校名")).Value).Item(Cells(csvrow.row, dicHeader.Item("学年")).Value).Add Cells(csvrow.row, dicHeader.Item("クラス")).Value, New Scripting.Dictionary
            End If
            
            '最後列ごとで、タイトルと値を連想配列に格納する
            For Each csvfield In csvrow.Columns
                gReits.Item(Cells(csvrow.row, dicHeader.Item("学校名")).Value).Item(Cells(csvrow.row, dicHeader.Item("学年")).Value).Item(Cells(csvrow.row, dicHeader.Item("クラス")).Value).Add dicHeaderRev.Item(csvfield.Column), csvfield.Value
            Next
            
        End If
    Next
    wb.Close SaveChanges:=False
    set wb = nothing
    set st = nothing
    'ここまで、csvのデータがすべてグローバル連想配列変数gReitsに格納したはず、あとは好きなように使うだけ
    call printOut
End Sub
Function SelectFileNamePath(FileType, Prompt) As Variant
  SelectFileNamePath = Application.GetOpenFilename(FileType, , Prompt)
End Function

Sub printOut()
    Dim gakkou As Variant
    Dim gakunen As Variant
    Dim class As Variant

    If gReits.Count > 0 Then
        For Each gakkou In gReits.Keys
            Debug.Print "学校名：" & gakkou
            For Each gakunen In gReits.Item(gakkou).Keys
                Debug.Print vbTab & "学年：" & gakunen
                For Each class In gReits.Item(gakkou).Item(gakunen).Keys
                    Debug.Print vbTab & vbTab & class
                    Debug.Print vbTab & vbTab & vbTab & gReits.Item(gakkou).Item(gakunen).Item(class).Item("名前") & "⇒" & _
                                                        "国語：" & gReits.Item(gakkou).Item(gakunen).Item(class).Item("国語") & _
                                                        "英語：" & gReits.Item(gakkou).Item(gakunen).Item(class).Item("英語") & _
                                                        "数学：" & gReits.Item(gakkou).Item(gakunen).Item(class).Item("数学")
                Next
            Next
        Next
    End If

End Sub

イミディエイトウィンドウの出力はこんな感じ 学校名：一小
  学年：3年
    1組
      田中⇒国語：90英語：80数学：70
  学年：2年
    2組
      渡辺⇒国語：78英語：76数学：80
    1組
      中田⇒国語：67英語：89数学：53
学校名：ニ小
    学年：3年
    1組
      佐藤⇒国語：34英語：60数学：90
    2組
      山田⇒国語：43英語：57数学：78
    学年：1年
    3組
      田中⇒国語：66英語：66数学：78