Startseite / Tipps / VB 5/6-Tipp 0603: Erweiterte Split-Funktion

VB 5/6-Tipp 0603: Erweiterte Split-Funktion

 von Helge Rex

'Dieser Quellcode stammt von http://www.activevb.de
'und kann frei verwendet werden. Für eventuelle Schäden
'wird nicht gehaftet.

'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
'Ansonsten viel Spaß und Erfolg mit diesem Source!

'------------- Anfang Projektdatei Projekt1.vbp -------------
'--------- Anfang Formular "Form1" alias Form1.frm  ---------
' Steuerelement: Listen-Steuerelement "List1"
' Steuerelement: Schaltfläche "Command1"
' Steuerelement: Textfeld "Text1"

Option Explicit

Private Function MultiSplit(ByVal StringToParse As String, _
    ParamArray Delimiter() As Variant) As String()
    
    ' Diese Funktion zerlegt einen eingegebenen Text.
    ' Als Delimiter für die einzelnen Teile können beliebig viele Zeichen angegeben werden.
    ' Es wird ein Array zurückgegeben, welches die gefundenen Elemente enthält.
    ' Werden Delimiter mit einem BackSlash maskiert,
    ' verlieren sie ihre Bedeutung als Delimiter.
    Dim strEingabe As String        '   Text nach Kodierung und Optimierung
    Dim lngDelimCount As Long       '   Anzahl Delimiter
    Dim lngDelimPos As Long         '   Position des Delimiters
    Dim lngPos As Long              '   Aktuelle Position im Text
    Dim strAusgabe() As String      '   Ausgabeliste
    Dim lngAusgabe As Long          '   Anzahl Elemente in der Ausgabeliste
    Dim lngSuche As Long            '   Position des nächsten Delimiters
    
    '   Doppelte, führende und abschließende Leerzeichen entfernen
    strEingabe = Trim$(StringToParse)
    strEingabe = Replace$(strEingabe, "  ", " ")
    
    '   Alle Delimiter durchlaufen
    For lngDelimCount = LBound(Delimiter) To UBound(Delimiter)
        '   Maskierten Delimiter ersetzen
        strEingabe = Replace$(strEingabe, "\" & Delimiter(lngDelimCount), _
            "DELIM" & CStr(lngDelimCount))
    Next lngDelimCount
    
    '   Position, ab der gesucht wird
    lngPos = 2
    
    '   Ausgabe auf 1 Feld dimensionieren
    ReDim strAusgabe(0 To 0)
    lngAusgabe = LBound(strAusgabe)
    
    '   Text durchsuchen
    Do
        '   Position des nächsten Delimiters ist unbekannt
        lngSuche = 0
        
        '   Alle Delimiter durchlaufen
        For lngDelimCount = LBound(Delimiter) To UBound(Delimiter)
            '   Position suchen
            lngDelimPos = InStr(lngPos, strEingabe, Delimiter(lngDelimCount), vbTextCompare)
            
            '   Ist noch kein Delimiter bekannt?
            If (lngSuche = 0) Then
                '   Ja, Position dieses Delimiters speichern
                lngSuche = lngDelimPos
            Else
                '   Nein, ist ein Delimiter gefunden worden und
                '   ist die Position kleiner als die bisher gefundene?
                If (lngDelimPos <> 0) And (lngSuche > lngDelimPos) Then
                    '   Ja, Positin des Delimiters speichern
                    lngSuche = lngDelimPos
                End If
            End If
        Next lngDelimCount
        
        '   Muß das Ausgabe-Feld redimensioniert werden?
        If (lngAusgabe > UBound(strAusgabe)) Then
            '   Ja, also weitere 10 Felder einfügen
            ReDim Preserve strAusgabe(LBound(strAusgabe) To UBound(strAusgabe) + 10)
        End If
        
        '   Wurde ein Zeichen gefunden?
        If (lngSuche <> 0) Then
            '   Ja, Teil einfügen
            strAusgabe(lngAusgabe) = Trim$(Mid$(strEingabe, _
                lngPos - 1, lngSuche - lngPos + 1))
            
            '   Position neu setzen
            lngPos = lngSuche + 1
        Else
            '   Nein, den Rest kopieren
            strAusgabe(lngAusgabe) = Mid$(strEingabe, lngPos - 1)
        End If
        
        '   Alle Delimiter durchlaufen
        For lngDelimCount = LBound(Delimiter) To UBound(Delimiter)
            '   Ersetzten Delimiter maskieren
            strAusgabe(lngAusgabe) = Replace$(strAusgabe(lngAusgabe), _
                "DELIM" & CStr(lngDelimCount), "\" & Delimiter(lngDelimCount))
        Next lngDelimCount
        
        '   Index inkrementieren
        lngAusgabe = lngAusgabe + 1
    Loop Until (lngSuche = 0)
    
    '   Ausgabe zurechtstutzen (lngAusgabe ist wegen der Umwandlung um eins zu groß)
    ReDim Preserve strAusgabe(LBound(strAusgabe) To lngAusgabe - 1)

    '   Ausgabe zurückgeben
    MultiSplit = strAusgabe
End Function

Private Sub Command1_Click()
    Dim lngCount As Long
    Dim strAusgabe() As String
    
    '   Alte Liste leeren
    Me.List1.Clear
    
    '   Eingabe zerlegen (Delimiter: + - *)
    strAusgabe = MultiSplit(Me.Text1, "+", "-", "*")
    
    '   Zerlegte Eingabe in die Liste schreiben
    For lngCount = LBound(strAusgabe) To UBound(strAusgabe)
        Me.List1.AddItem strAusgabe(lngCount)
    Next lngCount
End Sub

Private Sub Form_Load()
    '   Beispiel-Text
    Me.Text1 = "+Visual Basic -.Net +Text1\*Text2"
End Sub
'---------- Ende Formular "Form1" alias Form1.frm  ----------
'-------------- Ende Projektdatei Projekt1.vbp --------------

Tipp-Kompatibilität:

Windows/VB-Version	Win32s	Win95	Win98	WinME	WinNT4	Win2000	WinXP
VB4
VB5
VB6

Hat dieser Tipp auf Ihrem Betriebsystem und mit Ihrer VB-Version funktioniert?

Ja, funktioniert!

Nein, funktioniert nicht bei mir!

VB-Version: VB6 VB5 VB4

Windows-Version: Windows XP Windows 2000 Windows NT4 Windows Me Windows 98 Windows 95 Win32s

Archivierte Nutzerkommentare 

Klicken Sie diesen Text an, wenn Sie die 3 archivierten Kommentare ansehen möchten.
Diese stammen noch von der Zeit, als es noch keine direkte Forenunterstützung für Fragen und Kommentare zu einzelnen Artikeln gab.
Aus Gründen der Vollständigkeit können Sie sich die ausgeblendeten Kommentare zu diesem Artikel aber gerne weiterhin ansehen.

'   Position, ab der gesucht wird
    lngPos = 1 'auf 1 setzen, nicht erst beim 2. Zeichen anfangen

'   Position suchen
            lngDelimPos = InStr(lngPos, strEingabe,  _
            Delimiter(lngDelimCount)) 'hier vbTextCompare weglassen? glaub ich zumindest

'   Ja, Teil einfügen
            strAusgabe(lngAusgabe) = Trim$(Mid$(strEingabe, lngPos, IIf(lngSuche = lngPos, 0, lngSuche - lngPos))) 'muss so aussehen damit ein direkt anschließender Delimiter nicht ignoriert wird und weil wir mit dem Suchen bei 1 angefangen haben

'   Nein, den Rest kopieren
           strAusgabe(lngAusgabe) = Mid$(strEingabe, lngPos) 'kein -1 mehr da wir ja jetz bei 1 angefangen haben