VBA Tipp: Zeichenkette aus einem String mit Delimitern extrahieren

Aus DBWiki
Wechseln zu: Navigation, Suche

Anforderung

Aus einem String (Zeichenfolge) soll ein, zwischen zwei frei wählbaren Trennzeichen stehender Teilstring extrahiert und zurückgegeben werden. Bei Eingabe von ungültigen Werten gibt die Funktion einen Leerstring ("") zurück.

Lösung

Das ist mit folgender Funktion möglich, die in einem globalen Modul gespeichert wird.

Argumente der Funktion

Text String, der untersucht werden soll
TrennZchn1 Erstes Trennzeichen
NumTrennZchn1 Vorkommen des ersten Trennzeichens (Wert muss > 0 sein)
TrennZchn2 Zweites Trennzeichen
NumTrennZchn2 Vorkommen des zweiten Trennzeichens (Wert muss > 0 sein)
RelativPosition True = NumTrennZchn2 ist relativ zum ersten Trennzeichen
False = NumTrennZchn2 ist absolut zum Text
Public Function ExtrahiereAusString(ByVal Text As String, _
                                    Optional ByVal TrennZchn1 As String = ";", _
                                    Optional ByVal NumTrennZchn1 As Long = 1, _
                                    Optional ByVal TrennZchn2 As String = ";", _
                                    Optional ByVal NumTrennZchn2 As Long = 1, _
                                    Optional ByVal RelativPosition As Boolean = True _
                                  ) As String
 
   'Quelle: www.dbwiki.net oder www.dbwiki.de
 
   Dim StartPos     As Long
   Dim EndPos       As Long
   Dim SearchLoops  As Long
 
   Do While SearchLoops < NumTrennZchn1
      StartPos = InStr(StartPos + 1, Text, TrennZchn1, vbTextCompare)
      If StartPos = 0 Then
         Exit Function
      End If
      SearchLoops = SearchLoops + 1
   Loop
 
   StartPos = StartPos + 1
 
   SearchLoops = 0
   If RelativPosition Then
      EndPos = StartPos
   End If
   Do While SearchLoops < NumTrennZchn2
      EndPos = InStr(EndPos + 1, Text, TrennZchn2, vbTextCompare)
      If EndPos = 0 Then
         Exit Function
      End If
      SearchLoops = SearchLoops + 1
   Loop
 
   If EndPos < StartPos Then Exit Function
 
   ExtrahiereAusString = Mid$(Text, StartPos, EndPos - StartPos)
 
End Function

Aufruf

Ergebnis im Direktfenster anzeigen

   Dim strText As String
 
   strText = "1234;567890;1234567;890;12367; Bester;  Ein"
   Debug.Print ExtrahiereAusString(strText)                  'ergibt 567890
   Debug.Print ExtrahiereAusString(strText, , 2)             'ergibt 1234567
   Debug.Print ExtrahiereAusString(strText, , 2, , 2)        'ergibt 1234567;890
 
   strText = ";Text1;Text;Text2;"
   Debug.Print ExtrahiereAusString(strText, , 2)             'ergibt Text
 
   strText = "<span>EinText</span>"
   Debug.Print ExtrahiereAusString(strText, ">", , "<")      'ergibt EinText
   Debug.Print ExtrahiereAusString(strText, "<", , ">")      'ergibt span
   Debug.Print ExtrahiereAusString(strText, "<", 2, ">")     'ergibt /span
   Debug.Print ExtrahiereAusString(strText, "<", 2, ">", 2)  'ergibt Leerstring ("")
 
   strText = "http://musterseite.de/unterordner/index.htm"
   Debug.Print ExtrahiereAusString(strText, "/", 3, "/")     'ergibt unterordner