VBA에서 문자열 리터럴 내부의 쉼표를 무시하고 CSV를 구문 분석하시겠습니까?

VBA에서 문자열 리터럴 내부의 쉼표를 무시하고 CSV를 구문 분석하시겠습니까?

매일 실행되는 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의 스플릿() 기능을 사용해 왔습니다. 바퀴를 다시 만들고 싶지 않기 때문입니다. 하지만 해야 한다면 다른 것을 해야 할 것 같습니다.

어떤 제안이든 감사하겠습니다.

이 문제를 해결하는 첫 번째 방법은 csv 파일(int,int,"String literal, 최대 하나의 쉼표를 가질 것" 등)에서 줄의 구조를 보는 것입니다.간단한 해결책은 (라인에 세미콜론이 없다고 가정할 때)

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 여기를 참조하십시오.

따옴표가 있는 필드 내에 따옴표가 없다고 가정할 때 CSV 행을 구문 분석하기 위한 간단한 정규식은 다음과 같습니다.

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

각 일치 항목은 필드를 반환합니다.

@김프가 말하길...

현재 답변에 충분한 세부 정보가 없습니다.

저도 같은 문제에 봉착했습니다.이 답변에서 더 자세한 내용을 찾고 있습니다.

@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

InsertArray를 사용자 지정해야 합니다.자신의 테이블에 대한 데이터베이스 하위로 이동합니다.내 것에는 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() 이전에 ParseCSV()실행합니다. 를 실행하기 때문입니다.CurrentDb()루프에서는 특히 매우 큰 파일에서 매우 느립니다.

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

이것이 오래된 게시물인 것은 알지만, 이것이 다른 사람들에게 도움이 될 수도 있다고 생각했습니다.이것은 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

이 게시물이 오래된 게시물이라는 것을 알고 있지만, OP가 가지고 있던 것과 같은 문제에 대한 해결책을 찾다가 우연히 발견했기 때문에 스레드는 여전히 관련이 있습니다.

CSV에서 데이터를 가져오려면 워크시트에 쿼리를 추가합니다.

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

Querytable 그다 적한쿼테절매예설변정다니합수를개블이리음런예:(다▁then▁param니eters▁the▁().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), 하지만 데이터의 원본과 대상이 변경되지 않으면 한 번만 생성한 다음 간단히 새로 고칠 수 있다고 생각합니다.

저는 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,jesus.christ@sky.com,Approver,""JC, ,Son"",Reviewer,god.allmighty@sky.com,""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 가져오기 문제를 해결하기 위해 상당한 여정을 거쳤기 때문에 도움이 되었으면 합니다.

최근 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

당신의 의견을 고려하면 당신은 여기서 쉽게 나갈 수 있습니다.

• -->에서 분할하면 3개 이상의 항목이 제공됩니다(문자열 리터럴 내부의 이중 따옴표로 인해 더 많을 수 있음).
• 첫 번째 부분을 분할합니다.
• 파트 2부터 n-1까지 함께 보관(문자열 리터럴)
• 마지막 부분을 분할합니다.

먹어보세요![도구] 아래의 [참조]에서 "Microsoft VBScript 정규 표현식 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

소스 CSV에 모든 필드가 큰따옴표로 되어 있으면 분할(strLine, "", """)이 잘 작동할 수 있습니다.

split() 및 join()에 기반한 솔루션은 문자를 반복하는 것에 비해 매우 빠른 경향이 있습니다.따옴표로 묶은 문자열에 쉼표가 여러 개 있거나 줄 바꿈이 여러 개 있을 경우 정규식을 사용하는 것도 어렵습니다.여기 있는 그런 파일을 가지고 일하고 있었어요.

아래 함수는 상위 답변과 동일한 기본 메커니즘을 사용하지만 한 줄이 아닌 전체 파일을 처리합니다.간략화를 위해 선언문은 생략합니다.

Function CSVToArray(sourceText, rowDelim, columnDelim, Optional stringNotInSourceText = "|/", Optional removeErrorRows = False)
'Converts CSV text to a two-dimensional array.  It's fast by use of split() and join().
'To de-activate any combination of delimeter characters in quoted strings, they are first converted using the stringNotInSourceText argument
'The delimeter characters in the quoted strings are returned to their original values

    'Validate stringNotInSourceText
    If InStr(1, sourceText, stringNotInSourceText) > 0 Then
        Debug.Print "Error: The provided stringNotInSourceText appears in the sourceText"
    End If
    
    'Make replacement delimeters
    rowDelimReplacement = stringNotInSourceText & "R"
    columnDelimReplacement = stringNotInSourceText & "C"
    
    'Now, we need to separate quoted strings out so we can replace the delimeters inside them
    splitQuotes = Split(sourceText, """")
    
    'Amazing, if we loop through the array step 2, starting on 1, we get all the quoted strings
    For i = 1 To UBound(splitQuotes) Step 2
        splitQuotes(i) = Replace(splitQuotes(i), rowDelim, rowDelimReplacement)
        splitQuotes(i) = Replace(splitQuotes(i), columnDelim, columnDelimReplacement)
    Next
    
    'Rejoin to a now disambiguated text (a rowDelim and columnDelim character are now always actual delimeters)
    disambiguatedText = Join(splitQuotes, """")
    
    'Now we can split the disambiguated text to rows, without interference from characters in quotes
    rowArray = Split(disambiguatedText, rowDelim)
    
    'Use a sample row to count the number of columns
    rowSample = Split(rowArray(0), columnDelim)
    rowSampleUBound = UBound(rowSample)
    
    'Populate the two-dimensional array, restoring the original characters inside quote
    Set goodRowList = CreateObject("System.Collections.ArrayList")
    errorTemplate = "Error: Row #R has #U of #SU expected columns. "
    errorTemplate = errorTemplate & IIf(removeErrorRows, "Row removed.", "Row kept with up to #SU columns.")
    ReDim returnArray(0 To UBound(rowArray), 0 To rowSampleUBound)
    On Error Resume Next 'If a row has insufficient columns, debug.print the error template but keep going
        For r = 0 To UBound(returnArray, 1)
            SplitRow = Split(rowArray(r), columnDelim)
            rowUbound = UBound(SplitRow)
            If rowUbound <> rowSampleUBound Then
                Debug.Print Replace(Replace(Replace(errorTemplate, "#R", r), "#U", rowUbound), "#SU", rowSampleUBound)
            ElseIf removeErrorRows Then 'Storing good rows to remove the rest at the end
                goodRowList.Add r
            End If
            For c = 0 To rowSampleUBound
                restoredValue = SplitRow(c)
                restoredValue = Replace(restoredValue, rowDelimReplacement, rowDelim)
                restoredValue = Replace(restoredValue, columnDelimReplacement, columnDelim)
                returnArray(r, c) = restoredValue
            Next
        Next
    On Error GoTo 0
    
    'If removeErrorRows is set to true, this will remove the rows that were designated as having the wrong number of columns
    If removeErrorRows Then
        originalCount = 0
        ReDim cleanArray(0 To goodRowList.Count - 1, 0 To rowSampleUBound)
        For r = 0 To goodRowList.Count - 1
            For c = 0 To rowSampleUBound
                cleanArray(r, c) = returnArray(originalCount, c)
            Next
            originalCount = originalCount + 1
        Next
        returnArray = cleanArray
    End If

    CSVToArray = returnArray
    
End Function

가장 쉬운 솔루션은 GitHub에서 VBA로 작성된 CSV 파서를 다운로드하는 것입니다.적어도 세 가지는 가능합니다. 저는 이 책의 저자입니다.

https://github.com/PGS62/VBA-CSV

그러면 OP의 질문에 대한 답은 함수를 호출하는 것입니다.CSVRead질문에 주어진 예제 문자열 전달:

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

1x7 배열을 반환합니다.

정규식은 느리고 변동성이 제한된 문제입니다.

쉼표와 따옴표에 대해서만 상황에 따라 동작합니다.

따라서 무차별 논리는 쓰기 쉽고, 실행 속도가 빠르며, 이해하기 쉽습니다.이 코드는 Regex보다 훨씬 빠릅니다. 타이밍을 맞추지 않으면 5-10배 더 빠를 수 있습니다.배치 작업에 중요합니다.

' A fast, hard-coded method for splitting a CSV string which contains quoted sections
' e.g. 1,2,"comma,Separated,Values",Comma,Separated,Values will be split to 1, 2, "Comma,Separated,Values", Comma, Separated, Values
Public Function TokenizeCsvFast(sourceLine As String)
    
    Dim tokens() As String
    ReDim tokens(1 To 1)
    
    Dim processedTokenNumber As Long
    Dim newToken As String
    Dim newTokenNumber As Long
    newTokenNumber = 0
    
    Dim inQuotes As Boolean
    
    Dim stringPosition As Long
    For stringPosition = 1 To Len(sourceLine)
        
        Dim newCharacter As String
        newCharacter = Mid$(sourceLine, stringPosition, 1)
        
        Dim newTokenComplete As Boolean
        newTokenComplete = False
        
        If newCharacter = """" Then   ' Handle quotes as an explicit case
            inQuotes = Not inQuotes
        ElseIf newCharacter = "," Then

            If inQuotes Then
                ' if in quotes, just build up the new token
                newToken = newToken & newCharacter
            Else
                ' Outside of quotes, a comma separates values
                newTokenComplete = True
            End If

        ElseIf stringPosition = Len(sourceLine) Then
            ' The terminal token may not have a terminal comma
            newToken = newToken & newCharacter
            newTokenComplete = True
        Else
            ' Build up the new token one character at a time
            newToken = newToken & newCharacter
        End If
        
        If newTokenComplete Then
            processedTokenNumber = processedTokenNumber + 1
            
            ' Add the completed new token to the return array
            newTokenNumber = newTokenNumber + 1
            If newTokenNumber > UBound(tokens) Then
                ReDim Preserve tokens(1 To newTokenNumber)
            End If
            tokens(newTokenNumber) = newToken
            ' Debug.Print newToken
            
            ' Start new token afresh
            newToken = ""
            
        End If
        
    Next
    
    TokenizeCsvFast = tokens
    
End Function

언급URL : https://stackoverflow.com/questions/6780765/parse-csv-ignoring-commas-inside-string-literals-in-vba