Zerlegen einer CSV-Zeile in einen String-Array

Download udf_parsecsvline.bas (V-1.0.0)

Array<String> = parseCsvLine(line [,delemiter[,quote [,trim]]])

Public Function parseCsvLine( _
        ByVal iLine As String, _
        Optional ByVal iDelemiter As String = ";", _
        Optional ByVal iQuote As String = "'""", _
        Optional ByVal iTrim As Boolean = True _
) As String()

• iDelemiter Zeile
• iDelemiter Delemiter für dieFleder: Standars: ;
• iQuote Textbegrenzungszeichen Standard: ' unn “
  Einer von beiden. Derjenige der Zuserst kommt, ist für die ganze Zeile gültig
  Der Wert muss aus einzelnen Zeichen bestehen, di im Pattern in [] gesetzt werden
• iTrim Flag, ob die Werte getrimmt werden sollen Standard: true

• return Array<String>

Für die Ausgabe der Resultate verwendete ich die Funktion [VBA] print_r().

d parseCsvLine("123;abc;'def;ghi';;;0.12;")
<String()>  (
    [0] => <String> '123'
    [1] => <String> 'abc'
    [2] => <String> 'def;ghi'
    [3] => <String> ''
    [4] => <String> ''
    [5] => <String> '0.12'
    [6] => <String> ''
)
 
'Mit "" als Quote mit Trim
d parseCsvLine("""abc;'def' "";0.12")
<String()>  (
    [0] => <String> 'abc;'def''
    [1] => <String> '0.12'
)
'Mit ' Als Quote und ohne trim
d parseCsvLine("'abc;""def ""';0.12",,,false)
<String()>  (
    [0] => <String> 'abc;"def "'
    [1] => <String> '0.12'
)
 
'Mit dem Setting Delemiter = # Quote = '
d parseCsvLine("12#""abc#def""#'ghi#jk'","#", "'")
<String()>  (
    [0] => <String> '12'
    [1] => <String> '"abc'
    [2] => <String> 'def"'
    [3] => <String> 'ghi#jk'
)

udf_parsecsvline.bas

Attribute VB_Name = "udf_parseCsvLine"
'-------------------------------------------------------------------------------
'File         : udf_parseCsvLine.bas
'               Copyright mpl by ERB software
'               All rights reserved
'               http://http://wiki.yaslaw.info/dokuwiki/doku.php/vba/functions/parsecsvline
'Environment  : VBA 2007 +
'Version      : 1.0.0
'Name         : parseCsvLine
'Author       : Stefan Erb (ERS)
'History      : 11.01.2016 - ERS - Creation
'-------------------------------------------------------------------------------
Option Explicit
 
'/**
' * Parst eine csv-Zeile in ein StringArray
' * Array<String> = parseCsvLine(line [,Delemiter [,Quote, [,trim]]])
' * @param  String      Zeile
' * @param  String      Delemiter   Standars: ;
' * @param  String      Quote       Standard:   '" Einer von beiden. Derjenige der Zuserst kommt, ist für die ganze Zeile gültig
' *                                             Der Wert muss aus einzelnen Zeichen bestehen, di im Pattern in [] gesetzt werden
' * @param  Boolean     Flag, ob die Werte getrimmt werden sollen   Standard: true
' * @return Array<String>
' */
Public Function parseCsvLine( _
        ByVal iLine As String, _
        Optional ByVal iDelemiter As String = ";", _
        Optional ByVal iQuote As String = "'""", _
        Optional ByVal iTrim As Boolean = True _
) As String()
    'RegExp aufsetzen und behalten (cachen)
    Static dm As String
    Static qt As String
    Static rxRow As Object
    'Bei Änderung der Paramter den Pattern neu zusammensetzen
    If rxRow Is Nothing Or dm <> iDelemiter Or qt <> iQuote Then
        dm = iDelemiter
        qt = iQuote
        '("/(?:^;|(['""])\1;|(['""])([^\2]+?)\2(?=;|$)|([^;]+?)(?=;|$)|;(?=;|$))/g")
        '(?:Zeilenbegin mit einem ; | Leerstring mit Quotes | String in Quotes | String ohne Quotes | ; gefolgt von einem ; oder dem Zeilenende)
        Set rxRow = CreateObject("VBScript.RegExp")
        rxRow.pattern = "(?:^" & dm & "|([" & qt & "])\1|([" & qt & "])([^\2]+?)\2(?=" & dm & "|$)|([^" & dm & "]+?)(?=" & dm & "|$)|" & dm & "(?=" & dm & "|$))"
        rxRow.Global = True
    End If
 
    'Zeile auswerten
    Dim retArr() As String
    If rxRow.test(iLine) Then
        With rxRow.execute(iLine)
            ReDim retArr(.Count - 1)
            Dim i As Long: For i = 0 To UBound(retArr)
                Dim fldValue As String: fldValue = .item(i).subMatches(2) & .item(i).subMatches(3)
                retArr(i) = IIf(iTrim, Trim(fldValue), fldValue)
            Next i
        End With
    End If
    parseCsvLine = retArr
End Function