VB-Tec.de Visual Basic - Technik, FAQ, Tricks, Beispiele

Problem

Mit der von VB zur Verfügung gestellten InStr-Funktion ist es möglich, innerhalb eines Textes einen bestimmten String zu finden. So liefert InStr("Willi Wacker", "ack") als Ergebnis 8 zurück.

Dagegen kann mit dem Like-Operator festgestellt werden, ob ein Text einem bestimmten Pattern entspricht. Dabei wird "?" als genau ein beliebiges Zeichen interpretiert, "*" als beliebig viele Zeichen; Mit der Notation "[abc]" kann eine Zeichenauswahl vorgegeben werden (s.a. Online-Hilfe). So liefert "Willi Wacker" Like "*a?k*" als Ergebnis True zurück.

Leider gibt es in VB keine Funktion, welche die Eigenschaft von beiden hat, also die Position eines Patterns zurückgibt.

Lösung

Die unten vorgestellten Funktionen InStrLike (bzw. InStrLikeRev für "von hinten") wird ein Text nach einem Pattern durchsucht. Optional kann angegeben werden, ob Groß-/Kleinschreibung eine Rolle spielen soll (Compare, s.a. Online-Hilfe zu InStr).

Beispiele

n = InStrLike("Willi Wacker", "i?W")
'liefert 5

n = InStrLikeRev("Willi Wacker", "w?")
'liefert 0, wg. Kleinschreibung

n = InStrLikeRev("Willi Wacker", "w?", vbTextCompare)
'liefert 7

n = InStrLike("Willi Wacker", "W*r")
'liefert 1

n = InStrLikeRev("Willi Wacker", "W*r")
'liefert 7

Code

Die Suche "von vorne" ist ziemlich einfach gestrickt: Beim ersten Zeichen angefangen wird via Like geprüft, ob ab dort das Pattern zu finden ist. Falls nicht, so wird mit mit dem nächsten Zeichen fortgefahren. Aus Performance-Gründen wird für die Schleife via InStrLikeRev (s.u.) die letztmögliche Postion vorgegeben.

Public Function InStrLike( _
    ByVal Text As String, _
    ByVal Pattern As String, _
    Optional ByVal Compare As VbCompareMethod = vbBinaryCompare _
  ) As Long
  Dim Index As Long

  If Len(Pattern) Then
  
    'Ggf. Groß-/Kleinschreibung ignorieren:
    If Compare = vbTextCompare Then
      Text = LCase$(Text)
      Pattern = LCase$(Pattern)
    End If
    
    'Suchpattern erweitern:
    Pattern = Pattern & "*"
    
    'Lineare Suche durchführen:
    InStrLike = InStrLikeRev(Text, Pattern)
    For Index = 1 To InStrLike - 1
      If Mid$(Text, Index) Like Pattern Then
        'Treffer:
        InStrLike = Index
        Exit Function
      End If
    Next Index
  
  End If 'Len(Pattern)
End Function

Interessanterweise ist die Suche "von hinten" im Durchschnitt deutlich schneller als "von vorne", da hier "binäre Suche" verwendet werden kann: Erst wird geprüft, ob das Pattern in der hinteren Hälfte des Textes vorkommt. Falls ja, braucht die vordere Hälfte gar nicht mehr angeschaut werden. (Und so weiter...) So ist also bei doppelter Textlänge nur ein Vergleich mehr nötig, um das korrekte Ergebnis zu erhalten!

Public Function InStrLikeRev( _
    ByVal Text As String, _
    ByVal Pattern As String, _
    Optional ByVal Compare As VbCompareMethod = vbBinaryCompare _
  ) As Long
  Dim MinPos As Long
  Dim MaxPos As Long
  Dim Pivot As Long

  If Len(Pattern) Then
  
    'Ggf. Groß-/Kleinschreibung ignorieren:
    If Compare = vbTextCompare Then
      Text = LCase$(Text)
      Pattern = LCase$(Pattern)
    End If
    
    'Suchpattern erweitern:
    Pattern = "*" & Pattern & "*"
    
    'Binäre Suche durchführen:
    MinPos = 1
    MaxPos = Len(Text)
    Do Until MinPos > MaxPos
      Pivot = (MinPos + MaxPos) \ 2
      If Mid$(Text, Pivot) Like Pattern Then
        'Treffer merken:
        InStrLikeRev = Pivot
        MinPos = Pivot + 1
      Else
        MaxPos = Pivot - 1
      End If
    Loop
  
  End If 'Len(Pattern)
End Function