[Excel][VBA] CsvParser: CSVをパースするためのクラスモジュール

0.README.md

[Excel][VBA] CsvParser: CSVをパースするためのクラスモジュール

ExcelでCSVファイルをパースする（読み込んで行列データにする）場合には、PowerQueryやADODB.RecordSetを使う（自分も先日やってました）のが定番ですが（その他の方法もあり・詳細はこちらの記事がわかりやすいかと）、

• PowerQueryは必ずシート上のテーブル(ListObject)に読み込む必要がある
• ADODB.RecordSetは文字数が255文字まで・列数が255までといった制限がある

ということで、用途によっては使いにくいケースもあります。

そこで、CSVを読み込むためのクラスモジュールを作成してみました（正規表現を使って地道にパースしています）。

• CSVファイルを文字コードを指定してCSV文字列（VBAのString(Unicode)）化可能
• CSV文字列をパースして(ヘッダ部とデータ部をそれぞれを)ジャグ配列として取得可能
• ジャグ配列→二次元配列変換が可能
• パースした結果をシート上にも展開可能
• パース時の列のデータ型を指定可能
• 文字数・行数・列数の制限は特になし（VBAのString型や配列の許す限り・ただし、当然メモリその他のリソースの制限は受けるし（行数や列数が多すぎると実用的なパフォーマンスが出ないものと思われる）、シートに反映する場合にはExcelの制限も影響する）

試してみたい方はこちらからダウンロードできます（テスト用のブック(TestCsvParser.xlsm)およびデータ(「なんちゃって個人情報」により作成)を含む）。

詳細はダウンロードしたTestCsvParser.xlsmの「CsvParser仕様」シートをご参照ください。

動作確認はまだほとんど行っていません、不具合等がありましてもご自分で対応願います！←

また、パフォーマンス的にはよくないため、

• 文字数制限(1セル255文字まで)
• 列数制限(最大255列まで)

という制限があっても問題なければ、ADODB.Recordsetを用いてCSVファイルの内容をSELECTで取得する方法がいいのかなと思われます。

ソースコード

• CSVをパースするためのクラスモジュール(CsvParser)
• テスト用標準モジュール(Mod_Test)
• TSVパーステスト用標準モジュール(Mod_Test_Tsv)
• アマゾン注文履歴フィルタでダウンロードした注文履歴CSVをパースする例(Mod_Test_AmazonOrder)
• TwitterメディアダウンローダでダウンロードしたCSVをパースする例(Mod_Test_Tweets)

元ネタ

Excel VBA Diary@excelvba_diaryさんのツイート より

カラム数が255列を超え、フィールドにカンマの文字を含むCSVをWorksheetを経由せずに配列に読み込みたい。さて、あなたならどうする？

ほえほえ@hoehoe1234さんのツイートより

RFC1480準拠、スキャン一回、戻しはJag配列、滝Lib使わないで単一関数。みたいな縛りでCSV解析関数書いてみようかな。相互再帰は遅いので状態遷移で。シートはJag配列を受け入れるのでうれしいね。

CsvParser.vba

Option Explicit

' 以下の参照設定が必要
' - Microsoft VBScript Regular Expressions 5.5
' - Microsoft Scripting Runtime
' - Microsoft ActiveX Data Objects 6.1 Library

Private Const Version = "0.0.1.4"

Private Const DefaultRegFieldSeparator = ","

Public Enum CsvParserFieldType
    CFT_UNDEFINED
    CFT_BOOLEAN
    CFT_BYTE
    CFT_CURRENCY
    CFT_DATE
    CFT_DOUBLE
    CFT_DECIMAL
    CFT_INTEGER
    CFT_LONG
    CFT_LONGLONG
    CFT_LONGPTR
    CFT_SINGLE
    CFT_STRING
End Enum

Private RegCsvTrimmer As RegExp
Private RegCsvRecordParser As RegExp
Private RegCsvFieldParser As RegExp

Private LocalDefaultFieldType As CsvParserFieldType
Private LocalFieldTypes As Dictionary
Private LocalLastParseResult As Dictionary

Private LocalRegFieldSeparator

Private Fso As FileSystemObject

Private Sub Class_Initialize()
    RegFieldSeparator = DefaultRegFieldSeparator
    Call ResetFieldTypes
    Call ClearLastParseResult
    Set Fso = New FileSystemObject
End Sub

Private Sub Class_Terminate()
    Call ClearLastParseResult
    Call ResetFieldTypes
    Set RegCsvTrimmer = Nothing
    Set RegCsvRecordParser = Nothing
    Set RegCsvFieldParser = Nothing
    Set LocalFieldTypes = Nothing
    Set LocalLastParseResult = Nothing
End Sub

Public Property Get ModuleVersion()
    ModuleVersion = Version
End Property

Public Property Get DefaultFieldType() As CsvParserFieldType
    DefaultFieldType = LocalDefaultFieldType
End Property

Public Property Let DefaultFieldType( _
    SpecFieldType As CsvParserFieldType _
)
    LocalDefaultFieldType = SpecFieldType
End Property

Public Property Get FieldTypes() As Dictionary
    Set FieldTypes = LocalFieldTypes
End Property

Public Property Get FieldType( _
    FieldIndex _
) As CsvParserFieldType
    Dim FieldNumber As Long
    If IsNumeric(FieldIndex) Then
        FieldNumber = CLng(FieldIndex)
    Else
        FieldNumber = Columns(FieldIndex).Column
    End If
    If LocalFieldTypes.Exists(FieldNumber) Then
        FieldType = LocalFieldTypes(FieldNumber)
    Else
        FieldType = LocalDefaultFieldType
    End If
End Property

Public Property Let FieldType( _
    FieldIndex, _
    SpecFieldType As CsvParserFieldType _
)
    Dim FieldNumber As Long
    If IsNumeric(FieldIndex) Then
        FieldNumber = CLng(FieldIndex)
    Else
        FieldNumber = Columns(FieldIndex).Column
    End If
    LocalFieldTypes(FieldNumber) = SpecFieldType
End Property

Public Sub ResetFieldTypes()
    If Not LocalFieldTypes Is Nothing Then Call LocalFieldTypes.RemoveAll
    Set LocalFieldTypes = New Dictionary
    LocalDefaultFieldType = CFT_UNDEFINED
End Sub

Public Property Get RegFieldSeparator()
    RegFieldSeparator = LocalRegFieldSeparator
End Property

Public Property Let RegFieldSeparator(SpecifiedRegFieldSepeartor)
    LocalRegFieldSeparator = SpecifiedRegFieldSepeartor
    Call UpdateParserPatterns
End Property

Public Function GetCsvTextFromFile( _
    SourceCsvFilePath, _
    Optional Charset = "x-ms-cp932" _
) As String
' Charset: CSVファイルの文字コード
' ※ https://gist.github.com/furyutei/197a4d26bd98db5878f6a56244a3d6f4/ca41bfd87fcfb1f27942bcee4981fa6fc1a1a0de#adodbstream%E3%81%A7%E4%BD%BF%E3%81%88%E3%82%8B%E6%96%87%E5%AD%97%E3%82%B3%E3%83%BC%E3%83%89%E4%B8%80%E8%A6%A7
' 　で示したような文字コードを指定可能
    
    If Not Fso.FileExists(SourceCsvFilePath) Then
        Call Err.Raise(53, Description:="CSVファイルが見つかりません。" & vbCrLf & vbCrLf & SourceCsvFilePath)
        Exit Function
    End If
    
    Dim CsvText As String
    Dim FileNumber As Long: FileNumber = FreeFile
    Dim ByteBuffer() As Byte
    
    Open SourceCsvFilePath For Binary Access Read As #FileNumber
    Dim FileSize As Long: FileSize = LOF(FileNumber)
    If FileSize < 1 Then
        Close #FileNumber
        GetCsvTextFromFile = ""
        Exit Function
    End If
    ReDim ByteBuffer(0 To LOF(FileNumber) - 1)
    Get #FileNumber, 1, ByteBuffer
    Close #FileNumber
    
    With New ADODB.Stream
        .Mode = adModeReadWrite
        .Open
        .Type = adTypeBinary
        .Write ByteBuffer
        .Position = 0
        .Type = adTypeText
        .Charset = Charset
        CsvText = .ReadText(adReadAll)
        .Close
    End With
    
    With RegCsvTrimmer
        CsvText = .Replace(CsvText, "") ' UTF-16 BOM(&HFF, &HFE)と末尾のNULLを除去
    End With
    
    GetCsvTextFromFile = CsvText
End Function

Public Function ParseCsvText( _
    ByVal SourceCsvText, _
    Optional SpecHeaderRecordsCount As Long = 1 _
) As Dictionary
    Call ClearLastParseResult
    
    Dim ParseResult As Dictionary: Set ParseResult = New Dictionary
    Dim HeaderRecords As Dictionary: Set HeaderRecords = New Dictionary
    Dim DataRecords As Dictionary: Set DataRecords = New Dictionary
    Dim HeaderMaxFieldsCount As Long
    Dim DataMaxFieldsCount As Long
    
    With RegCsvRecordParser
        Dim RecordsCount As Long
        Dim MatchParts: Set MatchParts = .Execute(SourceCsvText)
        Dim MatchPart
        Dim WorkCsvRecord
        Dim WorkFields
        Dim WorkFieldsCount As Long
        Dim IsHeaderRecord As Boolean
        For Each MatchPart In MatchParts
            WorkCsvRecord = MatchPart.SubMatches(0)
            RecordsCount = RecordsCount + 1
            IsHeaderRecord = (RecordsCount <= SpecHeaderRecordsCount)
            WorkFields = ParseCsvRecordToFields(WorkCsvRecord, IsHeaderRecord)
            WorkFieldsCount = UBound(WorkFields) - LBound(WorkFields) + 1
            If IsHeaderRecord Then
                If HeaderMaxFieldsCount < WorkFieldsCount Then HeaderMaxFieldsCount = WorkFieldsCount
                HeaderRecords(HeaderRecords.Count) = WorkFields
            Else
                If DataMaxFieldsCount < WorkFieldsCount Then DataMaxFieldsCount = WorkFieldsCount
                DataRecords(DataRecords.Count) = WorkFields
            End If
        Next
    End With
    
    Dim HeaderRecordArray: HeaderRecordArray = HeaderRecords.Items
    If 0 < HeaderRecords.Count Then ReDim Preserve HeaderRecordArray(1 To HeaderRecords.Count)
    ParseResult("HeaderRecords") = HeaderRecordArray
    ParseResult("HeaderRecordsCount") = HeaderRecords.Count
    ParseResult("HeaderMaxFieldsCount") = HeaderMaxFieldsCount
    
    Dim DataRecordArray: DataRecordArray = DataRecords.Items
    If 0 < DataRecords.Count Then ReDim Preserve DataRecordArray(1 To DataRecords.Count)
    ParseResult("DataRecords") = DataRecordArray
    ParseResult("DataRecordsCount") = DataRecords.Count
    ParseResult("DataMaxFieldsCount") = DataMaxFieldsCount
    
    ParseResult("MaxFieldsCount") = WorksheetFunction.Max(HeaderMaxFieldsCount, DataMaxFieldsCount)
    
    Set LocalLastParseResult = ParseResult
    Set ParseCsvText = ParseResult
End Function

Public Property Get LastParseResult()
    Set LastParseResult = LocalLastParseResult
End Property

Public Property Get LastHeaderRecords()
    LastHeaderRecords = LocalLastParseResult("HeaderRecords")
End Property

Public Property Get LastHeaderRecordsCount() As Long
    LastHeaderRecordsCount = LocalLastParseResult("HeaderRecordsCount")
End Property

Public Property Get LastHeaderMaxFieldsCount() As Long
    LastHeaderMaxFieldsCount = LocalLastParseResult("HeaderMaxFieldsCount")
End Property

Public Property Get LastDataRecords()
    LastDataRecords = LocalLastParseResult("DataRecords")
End Property

Public Property Get LastDataRecordsCount() As Long
    LastDataRecordsCount = LocalLastParseResult("DataRecordsCount")
End Property

Public Property Get LastDataMaxFieldsCount() As Long
    LastDataMaxFieldsCount = LocalLastParseResult("DataMaxFieldsCount")
End Property

Public Property Get LastMaxFieldsCount() As Long
    LastMaxFieldsCount = LocalLastParseResult("MaxFieldsCount")
End Property

Public Property Get SpecHeaderRecords(Optional ByVal SpecParseResult)
    If IsMissing(SpecParseResult) Then Set SpecParseResult = LocalLastParseResult
    SpecHeaderRecords = SpecParseResult("HeaderRecords")
End Property

Public Property Get SpecHeaderRecordsCount(Optional ByVal SpecParseResult) As Long
    If IsMissing(SpecParseResult) Then Set SpecParseResult = LocalLastParseResult
    SpecHeaderRecordsCount = SpecParseResult("HeaderRecordsCount")
End Property

Public Property Get SpecHeaderMaxFieldsCount(Optional ByVal SpecParseResult) As Long
    If IsMissing(SpecParseResult) Then Set SpecParseResult = LocalLastParseResult
    SpecHeaderMaxFieldsCount = SpecParseResult("HeaderMaxFieldsCount")
End Property

Public Property Get SpecDataRecords(Optional ByVal SpecParseResult)
    If IsMissing(SpecParseResult) Then Set SpecParseResult = LocalLastParseResult
    SpecDataRecords = SpecParseResult("DataRecords")
End Property

Public Property Get SpecDataRecordsCount(Optional ByVal SpecParseResult) As Long
    If IsMissing(SpecParseResult) Then Set SpecParseResult = LocalLastParseResult
    SpecDataRecordsCount = SpecParseResult("DataRecordsCount")
End Property

Public Property Get SpecDataMaxFieldsCount(Optional ByVal SpecParseResult) As Long
    If IsMissing(SpecParseResult) Then Set SpecParseResult = LocalLastParseResult
    SpecDataMaxFieldsCount = SpecParseResult("DataMaxFieldsCount")
End Property

Public Property Get SpecMaxFieldsCount(Optional ByVal SpecParseResult) As Long
    If IsMissing(SpecParseResult) Then Set SpecParseResult = LocalLastParseResult
    SpecMaxFieldsCount = SpecParseResult("MaxFieldsCount")
End Property

Public Sub ClearLastParseResult()
    If Not LocalLastParseResult Is Nothing Then LocalLastParseResult.RemoveAll
    Set LocalLastParseResult = New Dictionary
End Sub

Public Function ParseCsvRecordToFields( _
    SourceCsvRecord, _
    Optional IsHeaderRecord As Boolean = False _
)
    Dim Fields As Dictionary: Set Fields = New Dictionary
    With RegCsvFieldParser
        Dim FieldsCount As Long
        Dim MatchPart
        Dim QuotedField
        Dim NormalField
        Dim WorkField
        Dim WorkFieldType
        For Each MatchPart In .Execute(SourceCsvRecord)
            FieldsCount = FieldsCount + 1
            QuotedField = MatchPart.SubMatches(0)
            NormalField = MatchPart.SubMatches(1)
            If QuotedField <> "" Then
                WorkField = Replace(QuotedField, """""", """")
            Else
                WorkField = NormalField
            End If
            
            On Error Resume Next
            If IsHeaderRecord Then
                WorkField = CStr(WorkField)
            ElseIf WorkField = "" Then
                WorkField = Empty
            Else
                Select Case FieldType(FieldsCount)
                    Case CFT_BOOLEAN
                        WorkField = CBool(WorkField)
                    Case CFT_BYTE
                        WorkField = CByte(WorkField)
                    Case CFT_CURRENCY
                        WorkField = CCur(WorkField)
                    Case CFT_DATE
                        WorkField = CDate(WorkField)
                    Case CFT_DOUBLE
                        WorkField = CDbl(WorkField)
                    Case CFT_DECIMAL
                        WorkField = CDec(WorkField)
                    Case CFT_INTEGER
                        WorkField = CInt(WorkField)
                    Case CFT_LONG
                        WorkField = CLng(WorkField)
                    Case CFT_LONGLONG
#If Win64 Then
                        WorkField = CLngLng(WorkField)
#Else
                        WorkField = CLngPtr(WorkField)
#End If
                    Case CFT_LONGPTR
                        WorkField = CLngPtr(WorkField)
                    Case CFT_SINGLE
                        WorkField = CSng(WorkField)
                    Case CFT_STRING
                        WorkField = CStr(WorkField)
                    Case Else
                        If IsEmpty(WorkField) Then
                            WorkField = Empty
                        ElseIf IsDate(WorkField) Then
                            WorkField = CDate(WorkField)
                        ElseIf IsNumeric(WorkField) Then
                            WorkField = CDbl(WorkField)
                        Else
                            WorkField = CStr(WorkField)
                        End If
                        If Err.Number <> 0 Then
                            Err.Clear
                            WorkField = CVar(WorkField)
                        End If
                End Select
            End If
            On Error GoTo 0
            Fields(Fields.Count) = WorkField
        Next
    End With
    ParseCsvRecordToFields = Fields.Items
End Function

Public Sub ApplyParseResultToRange( _
    ByVal LeftTopCell As Range, _
    Optional ByVal ParseResult _
)
    Set LeftTopCell = LeftTopCell.Resize(1, 1)
    If IsMissing(ParseResult) Then Set ParseResult = LocalLastParseResult

    Call ApplyParseResultHeadersToRange(LeftTopCell, ParseResult)
    Call ApplyParseResultDataToRange(LeftTopCell.Offset(ParseResult("HeaderRecordsCount"), 0), ParseResult)
End Sub

Public Sub ApplyParseResultHeadersToRange( _
    ByVal LeftTopCell As Range, _
    Optional ByVal ParseResult _
)
    Set LeftTopCell = LeftTopCell.Resize(1, 1)
    If IsMissing(ParseResult) Then Set ParseResult = LocalLastParseResult
    
    Dim HeaderRecordsCount: HeaderRecordsCount = ParseResult("HeaderRecordsCount")
    If HeaderRecordsCount < 1 Then Exit Sub
    
    Dim HeaderRecords: HeaderRecords = ParseResult("HeaderRecords")
'    Dim HeaderMaxFieldsCount As Long: HeaderMaxFieldsCount = ParseResult("HeaderMaxFieldsCount")
    Dim MaxFieldsCount As Long: MaxFieldsCount = ParseResult("MaxFieldsCount")
    Dim HeaderArray: HeaderArray = ConvertJaggedArrayTo2DArray(HeaderRecords, MaxFieldsCount, ForCellValue:=True, ForHeader:=True)
    
    LeftTopCell.Resize(HeaderRecordsCount, MaxFieldsCount).Value = HeaderArray
End Sub

Public Sub ApplyParseResultDataToRange( _
    ByVal LeftTopCell As Range, _
    Optional ByVal ParseResult _
)
    Set LeftTopCell = LeftTopCell.Resize(1, 1)
    If IsMissing(ParseResult) Then Set ParseResult = LocalLastParseResult
    
    Dim DataRecordsCount As Long: DataRecordsCount = ParseResult("DataRecordsCount")
    If DataRecordsCount < 1 Then Exit Sub
    
    Dim DataRecords: DataRecords = ParseResult("DataRecords")
'    Dim DataMaxFieldsCount As Long: DataMaxFieldsCount = ParseResult("DataMaxFieldsCount")
    Dim MaxFieldsCount As Long: MaxFieldsCount = ParseResult("MaxFieldsCount")
    Dim DataArray: DataArray = ConvertJaggedArrayTo2DArray(DataRecords, MaxFieldsCount, ForCellValue:=True)
    
    LeftTopCell.Resize(DataRecordsCount, MaxFieldsCount).Value = DataArray
    '【注意】
    '  セルに設定不可なデータがあると実行時エラー '1004'（アプリケーション定義またはオブジェクト定義のエラーです｡）が発生
    '  例) "028-11-188"はIsDate()がTrueで、データ型がCFT_UNDEFINEDの場合はCDate()で変換されるために「188/11/28」となるが、これはセルに設定不可
    '  その場合は予め
    '  .Field(該当する列番号) = CFT_STRING
    '  のように列の型を明示しておくと回避可能な場合もある
End Sub

Public Function ConvertJaggedArrayTo2DArray( _
    SourceJaggedArray, _
    Optional ByVal MaxFieldsCount As Long = 0, _
    Optional ForCellValue As Boolean = False, _
    Optional ForHeader As Boolean = False _
)
    Dim Result2DArray
    Dim WorkFields
    Dim WorkFieldsCount
    
    If MaxFieldsCount = 0 Then
        For Each WorkFields In SourceJaggedArray
            WorkFieldsCount = UBound(WorkFields) - LBound(WorkFields) + 1
            If MaxFieldsCount < WorkFieldsCount Then MaxFieldsCount = WorkFieldsCount
        Next
    End If
    On Error Resume Next
    ReDim Result2DArray(1 To UBound(SourceJaggedArray) - LBound(SourceJaggedArray) + 1, 1 To MaxFieldsCount)
    If Err.Number <> 0 Then Exit Function
    On Error GoTo 0
    
    Dim RecordsCount As Long
    Dim FieldsCount As Long
    Dim WorkField
    For Each WorkFields In SourceJaggedArray
        RecordsCount = RecordsCount + 1
        FieldsCount = 0
        For Each WorkField In WorkFields
            FieldsCount = FieldsCount + 1
            If ForCellValue Then
                Select Case True
                    Case ForHeader, FieldType(FieldsCount) = CFT_STRING
                        WorkField = "'" & WorkField
                End Select
            End If
            Result2DArray(RecordsCount, FieldsCount) = WorkField
        Next
    Next
    
    ConvertJaggedArrayTo2DArray = Result2DArray
End Function

Private Sub UpdateParserPatterns()
    Set RegCsvTrimmer = New RegExp
    With RegCsvTrimmer
        .Global = True
        .MultiLine = False
        .Pattern = "(?:^\ufeff|\u0000+$)" ' UTF-16 BOM(&HFF, &HFE)と末尾のNULL(削除対象)
    End With
    
    Set RegCsvRecordParser = New RegExp
    With RegCsvRecordParser
        .Global = True
        .MultiLine = False
        .Pattern = Replace("(?!(?:\r?\n)*$)(?:^|\r?\n)((?:,?(?:""(?:(?:[^""]|"""")*)""|.*?)(?=,|\r?\n|$))+)", ",", LocalRegFieldSeparator)
        '※終端にある改行のみの行は無視（"(?!(?:\r?\n)*$)"の箇所）
    End With
    
    Set RegCsvFieldParser = New RegExp
    With RegCsvFieldParser
        .Global = True
        .MultiLine = False
        .Pattern = Replace("(?:^|,)(?:""((?:[^""]|"""")*)""|(.*?))(?=,|$)", ",", LocalRegFieldSeparator)
    End With
End Sub

Mod_Test.vba

Option Explicit

Private Const DebugFlag = True

Sub TestCsvParser()
    Dim SourceInfos ' 0:CSVファイル/シート名, 1:文字コード, 2:ヘッダ行数, 3:デフォルトデータ型, 4～:(0:列番, 1:データ型)
    SourceInfos = VBA.Array( _
        VBA.Array("テストデータ_SJIS", Empty, Empty, CFT_STRING, VBA.Array(5, CFT_LONG), VBA.Array(6, CFT_DATE)), _
        VBA.Array("テストデータ_UTF8", "UTF-8", Empty, CFT_STRING, VBA.Array("E", CFT_LONG), VBA.Array("F", CFT_DATE)) _
    )
    
    Dim SourceCsvFilename
    Dim TargetSheet As Worksheet
    Dim LeftTopCell As Range
    Dim SourceInfo
    Dim InfoIndex As Long
    Dim InfoValue
    Dim Charset
    Dim HeaderCount
    Dim CsvText
    Dim ParseResult
    Dim ResultHeaderJaggedArray
    Dim ResultDataJaggedArray
    Dim ResultHeader2DArray
    Dim ResultData2DArray
    Dim StartTime
    Dim ProcessTime
    
    For Each SourceInfo In SourceInfos
        With New CsvParser
            InfoIndex = 0
            For Each InfoValue In SourceInfo
                Select Case InfoIndex
                    Case 0
                        SourceCsvFilename = ThisWorkbook.Path & "\" & InfoValue & ".csv"
                        Set TargetSheet = GetSheet(InfoValue)
                        Call TargetSheet.Cells.Clear
                    Case 1
                        Charset = InfoValue
                    Case 2
                        HeaderCount = InfoValue
                    Case 3
                        If Not IsEmpty(InfoValue) Then .DefaultFieldType = InfoValue
                    Case Else
                        .FieldType(InfoValue(0)) = InfoValue(1)
                End Select
                InfoIndex = InfoIndex + 1
            Next
            
            Debug.Print "[" & TargetSheet.Name & "]", "Charset:" & Charset
            
            StartTime = Timer
            ProcessTime = StartTime
            If IsEmpty(Charset) Then
                CsvText = .GetCsvTextFromFile(SourceCsvFilename) ' デフォルト: "x-ms-cp932"
            Else
                CsvText = .GetCsvTextFromFile(SourceCsvFilename, Charset:=Charset)
            End If
            Debug.Print " GetCsvTextFromFile(): " & Format(Timer - ProcessTime, "00:00:00.0")
            
            ProcessTime = StartTime
            If IsEmpty(HeaderCount) Then
                Set ParseResult = .ParseCsvText(CsvText)
            Else
                Set ParseResult = .ParseCsvText(CsvText, SpecHeaderRecordsCount:=CLng(HeaderCount))
            End If
            
            Debug.Print " ParseCsvText(): " & Format(Timer - ProcessTime, "00:00:00.0")
            Debug.Print " - Header 行数:" & .LastHeaderRecordsCount & " 列数:" & .LastHeaderMaxFieldsCount
            Debug.Print " - Record 行数:" & .LastDataRecordsCount & " 列数:" & .LastDataMaxFieldsCount
            
            If DebugFlag Then
'                Set ParseResult = .LastParseResult ' 直前の .ParseCsvText() の戻り値と同じ
                ProcessTime = Timer
                ResultHeaderJaggedArray = .LastHeaderRecords ' ParseResult("HeaderRecords")に同じ
                ResultDataJaggedArray = .LastDataRecords ' ParseResult("DataRecords")に同じ
                Debug.Print " ジャグ配列の取得: " & Format(Timer - ProcessTime, "00:00:00.0")
                ProcessTime = Timer
                ResultHeader2DArray = .ConvertJaggedArrayTo2DArray(ResultHeaderJaggedArray)
                ResultData2DArray = .ConvertJaggedArrayTo2DArray(ResultDataJaggedArray)
                Debug.Print " ジャグ配列→2次元配列変換: " & Format(Timer - ProcessTime, "00:00:00.0")
'                Stop
            End If
            
            ProcessTime = Timer
            Call .ApplyParseResultToRange(TargetSheet.Cells(1, 1))
            Debug.Print " ApplyParseResultToRange(): " & Format(Timer - ProcessTime, "00:00:00.0")
            
            Call TargetSheet.UsedRange.EntireColumn.AutoFit
            
            Debug.Print " (*) 合計所要時間 " & Format(Timer - StartTime, "00:00:00.0")
            Debug.Print String(80, "-")
        End With
    Next
End Sub

Private Function GetSheet(TargetSheetName) As Worksheet
    Dim TargetSheet As Worksheet
    On Error Resume Next
    With ThisWorkbook
        Set TargetSheet = .Worksheets(TargetSheetName)
        If Err.Number <> 0 Then
            Set TargetSheet = .Worksheets.Add(After:=.Worksheets(.Worksheets.Count))
            TargetSheet.Name = TargetSheetName
        End If
    End With
    Set GetSheet = TargetSheet
End Function

Mod_Test_AmazonOrder.vba

Option Explicit

' [アマゾン注文履歴フィルタ](https://github.com/furyutei/amzOrderHistoryFilter)
' でダウンロードした注文履歴CSVファイルをパースする例
' ※ブックと同じフォルダに"AmazonOrders.csv"という名前にリネームしたものを置いて、TestParseAmazonOrdersを実行

Sub TestParseAmazonOrders()
    Const CsvName = "AmazonOrders"
    With New CsvParser
        .DefaultFieldType = CFT_STRING
        .FieldType(1) = CFT_DATE
        .FieldType(5) = CFT_CURRENCY
        .FieldType(6) = CFT_LONG
        .FieldType(7) = CFT_CURRENCY
        .FieldType(8) = CFT_CURRENCY
        .FieldType(12) = CFT_CURRENCY
        .FieldType(13) = CFT_DATE
        .FieldType(14) = CFT_CURRENCY
        
        Debug.Print "[" & CsvName & "]"
        Dim TargetSheet: Set TargetSheet = GetSheet(CsvName): Call TargetSheet.Cells.Clear
        
        Dim StartTime: StartTime = Timer
        Dim ProcessTime: ProcessTime = StartTime
        Call .ParseCsvText(.GetCsvTextFromFile(ThisWorkbook.Path & "\" & CsvName & ".csv", Charset:="utf-8"))
        Debug.Print " GetCsvTextFromFile() & ParseCsvText(): " & Format(Timer - ProcessTime, "00:00:00.0")
        Debug.Print " - Header 行数:" & .LastHeaderRecordsCount & " 列数:" & .LastHeaderMaxFieldsCount
        Debug.Print " - Record 行数:" & .LastDataRecordsCount & " 列数:" & .LastDataMaxFieldsCount

        ProcessTime = Timer
        Call .ApplyParseResultToRange(TargetSheet.Cells(1, 1))
        Debug.Print " ApplyParseResultToRange(): " & Format(Timer - ProcessTime, "00:00:00.0")
        
        TargetSheet.UsedRange.EntireColumn.AutoFit
        
        Debug.Print " (*) 合計所要時間 " & Format(Timer - StartTime, "00:00:00.0")
        Debug.Print String(80, "-")
    End With
End Sub

Private Function GetSheet(TargetSheetName) As Worksheet
    Dim TargetSheet As Worksheet
    On Error Resume Next
    With ThisWorkbook
        Set TargetSheet = .Worksheets(TargetSheetName)
        If Err.Number <> 0 Then
            Set TargetSheet = .Worksheets.Add(After:=.Worksheets(.Worksheets.Count))
            TargetSheet.Name = TargetSheetName
        End If
    End With
    Set GetSheet = TargetSheet
End Function

Mod_Test_Tsv.vba

Option Explicit

' TCVを解析するテスト

Sub TestParseTsv()
    Const CsvName = "テストデータ_UTF8_TSV"
    With New CsvParser
        .DefaultFieldType = CFT_STRING
        .FieldType("E") = CFT_LONG
        .FieldType("F") = CFT_DATE
        Debug.Print ".RegFieldSepearator(default): " & .RegFieldSeparator
        .RegFieldSeparator = "\t" ' TAB区切りを指定
        Debug.Print ".RegFieldSepearator(changed): " & .RegFieldSeparator
        
        Debug.Print "[" & CsvName & "]"
        Dim TargetSheet: Set TargetSheet = GetSheet(CsvName): Call TargetSheet.Cells.Clear
        
        Dim StartTime: StartTime = Timer
        Dim ProcessTime: ProcessTime = StartTime
        Call .ParseCsvText(.GetCsvTextFromFile(ThisWorkbook.Path & "\" & CsvName & ".txt", Charset:="utf-8"))
        Debug.Print " GetCsvTextFromFile() & ParseCsvText(): " & Format(Timer - ProcessTime, "00:00:00.0")
        Debug.Print " - Header 行数:" & .LastHeaderRecordsCount & " 列数:" & .LastHeaderMaxFieldsCount
        Debug.Print " - Record 行数:" & .LastDataRecordsCount & " 列数:" & .LastDataMaxFieldsCount

        ProcessTime = Timer
        Call .ApplyParseResultToRange(TargetSheet.Cells(1, 1))
        Debug.Print " ApplyParseResultToRange(): " & Format(Timer - ProcessTime, "00:00:00.0")
        
        TargetSheet.UsedRange.EntireColumn.AutoFit
        
        Debug.Print " (*) 合計所要時間 " & Format(Timer - StartTime, "00:00:00.0")
        Debug.Print String(80, "-")
    End With
End Sub

Private Function GetSheet(TargetSheetName) As Worksheet
    Dim TargetSheet As Worksheet
    On Error Resume Next
    With ThisWorkbook
        Set TargetSheet = .Worksheets(TargetSheetName)
        If Err.Number <> 0 Then
            Set TargetSheet = .Worksheets.Add(After:=.Worksheets(.Worksheets.Count))
            TargetSheet.Name = TargetSheetName
        End If
    End With
    Set GetSheet = TargetSheet
End Function

Mod_Test_Tweets.vba

Option Explicit

' [Twitter メディアダウンローダ](https://github.com/furyutei/twMediaDownloader)
' でダウンロードしたCSVファイルをパースする例
' ※ブックと同じフォルダに"Tweets.csv"という名前にリネームしたものを置いて、TestParseTweetsを実行

Sub TestParseTweets()
    Const CsvName = "Tweets"
    Const HeaderRecordsCount = 5
    With New CsvParser
        .DefaultFieldType = CFT_STRING
        .FieldType(1) = CFT_DATE
        .FieldType(2) = CFT_DATE
        .FieldType(11) = CFT_LONG
        .FieldType(12) = CFT_LONG
        .FieldType(13) = CFT_LONG
        
        Debug.Print "[" & CsvName & "]"
        Dim TargetSheet: Set TargetSheet = GetSheet(CsvName): Call TargetSheet.Cells.Clear
        
        Dim StartTime: StartTime = Timer
        Dim ProcessTime: ProcessTime = StartTime
        Call .ParseCsvText(.GetCsvTextFromFile(ThisWorkbook.Path & "\" & CsvName & ".csv", Charset:="utf-8"), HeaderRecordsCount)
        Debug.Print " GetCsvTextFromFile() & ParseCsvText(): " & Format(Timer - ProcessTime, "00:00:00.0")
        Debug.Print " - Header 行数:" & .LastHeaderRecordsCount & " 列数:" & .LastHeaderMaxFieldsCount
        Debug.Print " - Record 行数:" & .LastDataRecordsCount & " 列数:" & .LastDataMaxFieldsCount
        
        ProcessTime = Timer
        Call .ApplyParseResultToRange(TargetSheet.Cells(1, 1))
        Debug.Print " ApplyParseResultToRange(): " & Format(Timer - ProcessTime, "00:00:00.0")
        
'        TargetSheet.UsedRange.EntireColumn.AutoFit
        
        Debug.Print " (*) 合計所要時間 " & Format(Timer - StartTime, "00:00:00.0")
        Debug.Print String(80, "-")
    End With
End Sub

Private Function GetSheet(TargetSheetName) As Worksheet
    Dim TargetSheet As Worksheet
    On Error Resume Next
    With ThisWorkbook
        Set TargetSheet = .Worksheets(TargetSheetName)
        If Err.Number <> 0 Then
            Set TargetSheet = .Worksheets.Add(After:=.Worksheets(.Worksheets.Count))
            TargetSheet.Name = TargetSheetName
        End If
    End With
    Set GetSheet = TargetSheet
End Function

Mod_Test_TweetsHeader1Line.vba

Option Explicit

' [Twitter メディアダウンローダ](https://github.com/furyutei/twMediaDownloader)
' でダウンロードしたCSVファイル（ヘッダを1行になるように編集したもの）をパースする例
' ※ブックと同じフォルダに"TweetsHeader1Line.csv"という名前にリネームしたものを置いて、TestParseTweetsを実行

Sub TestParseTweetsHeader1Line()
    Const CsvName = "TweetsHeader1Line"
    Const HeaderRecordsCount = 1
    With New CsvParser
        .DefaultFieldType = CFT_STRING
        .FieldType(1) = CFT_DATE
        .FieldType(2) = CFT_DATE
        .FieldType(11) = CFT_LONG
        .FieldType(12) = CFT_LONG
        .FieldType(13) = CFT_LONG
        
        Debug.Print "[" & CsvName & "]"
        Dim TargetSheet: Set TargetSheet = GetSheet(CsvName): Call TargetSheet.Cells.Clear
        
        Dim StartTime: StartTime = Timer
        Dim ProcessTime: ProcessTime = StartTime
        Call .ParseCsvText(.GetCsvTextFromFile(ThisWorkbook.Path & "\" & CsvName & ".csv", Charset:="utf-8"), HeaderRecordsCount)
        Debug.Print " GetCsvTextFromFile() & ParseCsvText(): " & Format(Timer - ProcessTime, "00:00:00.0")
        Debug.Print " - Header 行数:" & .LastHeaderRecordsCount & " 列数:" & .LastHeaderMaxFieldsCount
        Debug.Print " - Record 行数:" & .LastDataRecordsCount & " 列数:" & .LastDataMaxFieldsCount
        
        ProcessTime = Timer
        Call .ApplyParseResultToRange(TargetSheet.Cells(1, 1))
        Debug.Print " ApplyParseResultToRange(): " & Format(Timer - ProcessTime, "00:00:00.0")
        
'        TargetSheet.UsedRange.EntireColumn.AutoFit
        
        Debug.Print " (*) 合計所要時間 " & Format(Timer - StartTime, "00:00:00.0")
        Debug.Print String(80, "-")
    End With
End Sub

Private Function GetSheet(TargetSheetName) As Worksheet
    Dim TargetSheet As Worksheet
    On Error Resume Next
    With ThisWorkbook
        Set TargetSheet = .Worksheets(TargetSheetName)
        If Err.Number <> 0 Then
            Set TargetSheet = .Worksheets.Add(After:=.Worksheets(.Worksheets.Count))
            TargetSheet.Name = TargetSheetName
        End If
    End With
    Set GetSheet = TargetSheet
End Function