VBAの文字列リテラル内のコンマを無視してCSVを解析しますか？

Question

毎日実行されるVBAアプリケーションがあります。 CSVが自動的にダウンロードされるフォルダをチェックし、その内容をデータベースに追加します。それらを解析すると、特定の値の名前の一部にコンマが含まれていることに気付きました。これらの値は文字列リテラルに含まれていました。

したがって、このCSVを解析し、文字列リテラルに含まれるコンマを無視する方法を理解しようとしています。例えば...

1,2,3,"This should,be one part",5,6,7 Should return 

1
2
3
"This should,be one part"
5
6
7

車輪の再発明をしたくないので、VBAのsplit（）関数を使用していますが、必要な場合は別のことを行うと思います。

任意の提案をいただければ幸いです。

Answer 1

引用符で囲まれたフィールド内に引用符がないと仮定して、CSV行を解析するための単純な正規表現は次のとおりです。

"[^"]*"|[^,]*

一致するたびにフィールドが返されます。

Answer 2

この問題を解決する最初の方法は、csvファイルから行の構造を調べることです（int、int、 "文字列リテラル、最大で1つのコンマが含まれる"など）。単純な解決策は次のようになります（行にセミコロンがないと仮定）

Function splitLine1(line As String) As String()

   Dim temp() As String
   'Splits the line in three. The string delimited by " will be at temp(1)
   temp = Split(line, Chr(34)) 'chr(34) = "

   'Replaces the commas in the numeric fields by semicolons
   temp(0) = Replace(temp(0), ",", ";")
   temp(2) = Replace(temp(2), ",", ";")

   'Joins the temp array with quotes and then splits the result using the semicolons
   splitLine1 = Split(Join(temp, Chr(34)), ";")

End Function

この関数は、この特定の問題を解決するだけです。この作業を行う別の方法は、VBScriptの正規表現オブジェクトを使用することです。

Function splitLine2(line As String) As String()

    Dim regex As Object
    Set regex = CreateObject("vbscript.regexp")
    regex.IgnoreCase = True
    regex.Global = True

    'This pattern matches only commas outside quotes
    'Pattern = ",(?=([^"]*"[^"]*")*(?![^"]*"))"
    regex.Pattern = ",(?=([^" & Chr(34) & "]*" & Chr(34) & "[^" & Chr(34) & "]*" & Chr(34) & ")*(?![^" & Chr(34) & "]*" & Chr(34) & "))"

    'regex.replaces will replace the commas outside quotes with semicolons and then the
    'Split function will split the result based on the semicollons
    splitLine2 = Split(regex.Replace(line, ";"), ";")

End Function

この方法ははるかに不可解に見えますが、行の構造には依存しません

VBScriptで正規表現パターンの詳細を読むことができます ここ

Answer 3

@Gimpは言った...

現在の回答には十分な詳細が含まれていません。

私は同じ問題に直面しています。この回答で詳細を探しています。

@MRABの答えを詳しく説明するには：

Function ParseCSV(FileName)
    Dim Regex       'As VBScript_RegExp_55.RegExp
    Dim MatchColl   'As VBScript_RegExp_55.MatchCollection
    Dim Match       'As VBScript_RegExp_55.Match
    Dim FS          'As Scripting.FileSystemObject
    Dim Txt         'As Scripting.TextStream
    Dim CSVLine
    ReDim ToInsert(0)

    Set FS = CreateObject("Scripting.FileSystemObject")
    Set Txt = FS.OpenTextFile(FileName, 1, False, -2)
    Set Regex = CreateObject("VBScript.RegExp")

    Regex.Pattern = """[^""]*""|[^,]*"    '<- MRAB's answer
    Regex.Global = True

    Do While Not Txt.AtEndOfStream
        ReDim ToInsert(0)
        CSVLine = Txt.ReadLine
        For Each Match In Regex.Execute(CSVLine)
            If Match.Length > 0 Then
                ReDim Preserve ToInsert(UBound(ToInsert) + 1)
                ToInsert(UBound(ToInsert) - 1) = Match.Value
            End If
        Next
        InsertArrayIntoDatabase ToInsert
    Loop
    Txt.Close
End Function

独自のテーブル用にInsertArrayIntoDatabaseSubをカスタマイズする必要があります。鉱山には、f00、f01などの名前のテキストフィールドがいくつかあります。

Sub InsertArrayIntoDatabase(a())
    Dim rs As DAO.Recordset
    Dim i, n
    Set rs = CurrentDb().TableDefs("tbl").OpenRecordset()
    rs.AddNew
    For i = LBound(a) To UBound(a)
        n = "f" & Format(i, "00") 'fields in table are f00, f01, f02, etc..
        rs.Fields(n) = a(i)
    Next
    rs.Update
End Sub

CurrentDb()でInsertArrayIntoDatabase()を使用する代わりに、CurrentDb()beforeParseCSV()runsの値に設定されるグローバル変数を実際に使用する必要があることに注意してください。 、ループ内でのCurrentDb()の実行は、特に非常に大きなファイルでは非常に遅いためです。

Answer 4

MS Accessテーブルを使用している場合は、ディスクからテキストをインポートするだけでメリットがあります。例えば：

''If you have a reference to the Windows Script Host Object Model
Dim fs As New FileSystemObject
Dim ts As TextStream

''For late binding
''Dim fs As Object
''Dim ts As Object
''Set fs=CreateObject("Scripting.FileSystemObject")

Set ts = fs.CreateTextFile("z:\docs\import.csv", True)

sData = "1,2,3,""This should,be one part"",5,6,7"

ts.Write sData
ts.Close

''Just for testing, your table will already exist
''sSQL = "Create table Imports (f1 int, f2 int, f3 int, f4 text, " _
''     & "f5 int, f6 int, f7 int)"
''CurrentDb.Execute sSQL

''The fields will be called F1,F2 ... Fn in the text file
sSQL = "INSERT INTO Imports SELECT * FROM " _
     & "[text;fmt=delimited;hdr=no;database=z:\docs\].[import.csv]"
CurrentDb.Execute sSQL

Answer 5

私はこれが古い投稿であることを知っていますが、これは他の人を助けるかもしれないと思いました。これは盗用/改訂されました http://n3wt0n.com/blog/comma-separated-values-and-quoted-commas-in-vbscript/ ですが、非常にうまく機能し、関数として設定されています入力行を渡すことができます。

Function SplitCSVLineToArray(Line, RemoveQuotes) 'Pass it a line and whether or not to remove the quotes
    ReplacementString = "#!#!#"  'Random String that we should never see in our file
    LineLength = Len(Line)
    InQuotes = False
    NewLine = ""
    For x = 1 to LineLength 
        CurrentCharacter = Mid(Line,x,1)
        If CurrentCharacter = Chr(34) then  
            If InQuotes then
                InQuotes = False
            Else
                InQuotes = True
            End If
        End If
        If InQuotes Then 
            CurrentCharacter = Replace(CurrentCharacter, ",", ReplacementString)
        End If
        NewLine = NewLine & CurrentCharacter
    Next    
    LineArray = split(NewLine,",")
    For x = 0 to UBound(LineArray)
        LineArray(x) = Replace(LineArray(x), ReplacementString, ",")
        If RemoveQuotes = True then 
            LineArray(x) = Replace(LineArray(x), Chr(34), "")
        End If
    Next 
    SplitCSVLineToArray = LineArray
End Function

Answer 6

これは古い投稿だと思いますが、OPが抱えていたのと同じ問題の解決策を探してそれにぶつかったので、スレッドはまだ関連しています。

CSVからデータをインポートするには、ワークシートにクエリを追加します

_wksTarget.Querytables.add(Connection:=strConn, Destination:=wksTarget.Range("A1"))
_

次に、適切なQuerytableパラメータを設定します（例：_Name, FieldNames, RefreshOnOpen_など）

クエリテーブルは、TextFileCommaDelimiter、TextFileSemiColonDelimiterなどを介してさまざまな区切り文字を処理できます。また、ソースファイルの特異性を処理する他のパラメータ（_TextfilePlatform, TextFileTrailingMinusNumbers, TextFileColumnTypes, TextFileDecimalSeparator, TextFileStartRow, TextFileThousandsSeparator_）がいくつかあります。

OPに関連して、QueryTablesには、二重引用符で囲まれたコンマを処理するように設計されたパラメーターもあります-_TextFileQualifier = xlTextQualifierDoubleQuote_。

QueryTablesは、ファイルをインポートしたり、文字列を分割/解析したり、REGEX式を使用したりするコードを書くよりもはるかに簡単だと思います。

まとめると、サンプルコードスニペットは次のようになります。

_    strConn = "TEXT;" & "C:\Desktop\SourceFile.CSV"
    varDataTypes = Array(5, 1, 1, 1, 1, 1, 5, 5)
    With wksTarget.QueryTables.Add(Connection:=strConn, _ 
         Destination:=wksTarget.Range("A1"))
        .Name = "ImportCSV"
        .FieldNames = True
        .RefreshOnFileOpen = False
        .SaveData = True
        .TextFilePlatform = xlMSDOS
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileCommaDelimiter = True
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileColumnDataTypes = varDataTypes
        .Refresh BackgroundQuery:=False
    End With
_

データがインポートされたらQueryTableを削除することを好みます（wksTarget.QueryTable("ImportCSV").Delete）が、データのソースと宛先が変更されない場合は、一度だけ作成してから単純に更新できると思います。

Answer 7

最近、Excelで同様のCSV解析の課題が発生し、 CSVデータを解析するJavascriptコード から適応したソリューションを実装しました。

Function SplitCSV(csvText As String, delimiter As String) As String()

    ' Create a regular expression to parse the CSV values
    Dim RegEx As New RegExp

    ' Create pattern which will match each column in the CSV, wih submatches for each of the groups in the regex
    ' Match Groups:  Delimiter            Quoted fields                  Standard fields
    RegEx.Pattern = "(" + delimiter + "|^)(?:\""([^\""]*(?:\""\""[^\""]*)*)\""|([^\""\""" + delimiter + """]*))"
    RegEx.Global = True
    RegEx.IgnoreCase = True

    ' Create an array to hold all pattern matches (i.e. columns)
    Dim Matches As MatchCollection
    Set Matches = RegEx.Execute(csvText)

    ' Create an array to hold output data
    Dim Output() As String

    ' Create int to track array location when iterating
    Dim i As Integer
    i = 0

    ' Manually add blank if first column is blank, since VBA regex misses this
    If csvText Like ",*" Then
        ReDim Preserve Output(i)
        Output(i) = ""
        i = i + 1
    End If

    ' Iterate over all pattern matches and get values into output array
    Dim Match As Match
    Dim MatchedValue As String
    For Each Match In Matches

        ' Check to see which kind of value we captured (quoted or unquoted)
        If (Len(Match.SubMatches(1)) > 0) Then
            ' We found a quoted value. When we capture this value, unescape any double quotes
            MatchedValue = Replace(Match.SubMatches(1), """""", """")
        Else
            ' We found a non-quoted value
            MatchedValue = Match.SubMatches(2)
        End If

        ' Now that we have our value string, let's add it to the data array
        ReDim Preserve Output(i)
        Output(i) = MatchedValue
        i = i + 1

    Next Match

    ' Return the parsed data
    SplitCSV = Output

End Function

Answer 8

二重引用符内のコンマなど、可能な区切り文字を含む「引用符で囲まれた」テキスト文字列を含むCSVファイルを解析するための別のソリューションを作成しました。このメソッドは、正規表現やその他のアドオンを必要としません。また、このコードは引用符の間にある複数のコンマを扱います。テスト用のサブルーチンは次のとおりです。

Sub SubstituteBetweenQuotesSub()
'In-string character replacement function by Maryan Hutsul      1/29/2019
Dim quote, quoteTwo As Integer
Dim oddEven As Integer
Dim i, counter As Integer
Dim byteArray() As Byte

'LineItems are lines of text read from CSV file, or any other text string
LineItems = ",,,2019NoApocalypse.ditamap,[email protected],Approver,""JC, ,Son"",Reviewer,[email protected],""God, All-Mighty,"",2019-01-29T08:47:29.290-05:00"

quote = 1
oddEven = 0

Do Until quote = 0
quote = InStr(quote, LineItems, Chr(34))
quoteTwo = InStr(quote + 1, LineItems, Chr(34))

oddEven = oddEven + 1
    If oddEven Mod 2 = 1 And quote <> 0 Then

        counter = 0
        For i = quote To quoteTwo
            byteArray = StrConv(LineItems, vbFromUnicode)
            If i <> 0 Then
                If byteArray(i - 1) = 44 Then   '44 represents comma, can also do Chr(44)
                counter = counter + 1
                End If
            End If
        Next i

        LineItems = Left(LineItems, quote - 1) & Replace(LineItems, ",", ";", quote, counter)
        quote = quote + 1
    ElseIf quote <> 0 Then
        quote = quote + 1
    End If
Loop

End Sub

.csv、.txt、またはその他のテキストファイルから行を渡すことができる関数は次のとおりです。

Function SubstituteBetweenQuotes(LineItems)
'In-string character replacement function by Maryan Hutsul                                          1/29/2019
'LineItems are lines of text read from CSV file, or any other text string
Dim quote, quoteTwo As Integer
Dim oddEven As Integer
Dim i, counter As Integer
Dim byteArray() As Byte


quote = 1
oddEven = 0

Do Until quote = 0
quote = InStr(quote, LineItems, Chr(34))
quoteTwo = InStr(quote + 1, LineItems, Chr(34))

oddEven = oddEven + 1
    If oddEven Mod 2 = 1 And quote <> 0 Then

        counter = 0
        For i = quote To quoteTwo
            byteArray = StrConv(LineItems, vbFromUnicode)
            If i <> 0 Then
                If byteArray(i - 1) = 44 Then   '44 represents "," comma, can also do Chr(44)
                counter = counter + 1
                End If
            End If
        Next i

        LineItems = Left(LineItems, quote - 1) & Replace(LineItems, ",", ";", quote, counter)
        quote = quote + 1
    ElseIf quote <> 0 Then
        quote = quote + 1
    End If
Loop

SubstituteBetweenQuotes = LineItems

End Function

以下は、使用されている関数を使用してCSVファイルを読み取るためのコードです。

Dim fullFilePath As String
Dim i As Integer

'fullFilePath - full link to your input CSV file
Open fullFilePath For Input As #1
row_number = 0
column_number = 0
'EOF - End Of File  (1) - file #1
Do Until EOF(1)
    Line Input #1, LineFromFile
            LineItems = Split(SubstituteBetweenQuotes(LineFromFile), ",")
    For i = LBound(LineItems) To UBound(LineItems)
    ActiveCell.Offset(row_number, i).Value = LineItems(i)
    Next i
    row_number = row_number + 1
Loop
Close #1

すべての区切り文字と置換文字は、必要に応じて変更できます。 CSVインポートに関するいくつかの問題を解決するためにかなりの旅をしたので、これが役立つことを願っています

Answer 9

これを試して！ [ツール]の下の[参照]で[MicrosoftVBScript正規表現5.5]にチェックマークが付いていることを確認してください。

Function Splitter(line As String, n As Integer)
Dim s() As String
Dim regex As Object
    Set regex = CreateObject("vbscript.regexp")
    regex.IgnoreCase = True
    regex.Global = True
    regex.Pattern = ",(?=([^\""]*\""[^\""]*\"")*[^\""]*$)"
    s = split(regex.Replace(line, "|/||\|"), "|/||\|")
    Splitter = s(n - 1)
End Function

Answer 10

コメントを考慮に入れると、ここから簡単に抜け出すことができます

• 「->で分割すると、3つ以上のエントリが得られます（文字列リテラル内の二重引用符が原因である可能性があります）
• で最初の部分を分割します。
• パート2からn-1を一緒に保持します（文字列リテラルです）
• の最後の部分を分割します。