(-hg) 

Haben Sie schon einmal das Vorkommen von Teil-Strings ("Wörtern") in einem anderen String ("Text") gezählt? Ist nicht weiter schwierig, oder? Einfach eine Schleife, mit InStr die jeweils nächste Position finden und... Ja, okay. Aber eigentlich reicht dazu eine einzige Zeile, zumindest ab Visual Basic 6, die die Split-Funktion ein wenig "missbraucht":

Debug.Print UBound(Split(BaseString, SubString))

Verblüffend einfach, nicht wahr? Sie können dabei im letzten optionalen Parameter der Split-Funktion sogar noch angeben, ob nur Vorkommen mit exakt gleicher Schreibweise (vbBinaryCompare) oder ohne Berücksichtigung der Groß-/Kleinschreibung (vbTextCompare) gezählt werden sollen. In Ihrer Schleife können Sie dies natürlich auch mit einem Vergleich der Fundstellen über die StrCompare-Funktion erreichen.

Public Function SubStringCount(BaseString As String, _
 SubString As String, Optional ByVal Exact As Boolean) As Long
  Dim nCompare As VbCompareMethod
  
  Select Case Exact
    Case False
      nCompare = vbTextCompare
    Case True
      nCompare = vbBinaryCompare
  End Select
  SubStringCount = UBound(Split(BaseString, SubString, , nCompare))
End Function

Allerdings haben sowohl Ihre einfache Schleife wie auch diese Abkürzung noch einen kleinen Haken: Ganze "Wörter" im eigentlichen Sinn lassen sich so nicht zählen. Denn hierbei werden ja auch Wortbestandteile gefunden und mitgezählt. Auch kein Problem, werden Sie sagen? Sicher nicht - Sie schauen in Ihrer Schleife bei jeder Fundstelle nach, ob das jeweils vorhergehende und das jeweils nachfolgende Zeichen Worttrenner sind, also etwa ein Leerzeichen, ein Interpunktionszeichen und dergleichen.

Nun möchte sich der Anwender die Fundstellen in seinem Text vielleicht auch ansehen, eine nach der anderen.

	Fundstellen von Wörtern in einem Text anzeigen

Sie können natürlich dazu Ihre Fundstellensuche einzeln angehen, das nächste Vorkommen von der jeweils aktuellen Position aus suchen, bis das letzte Vorkommen gefunden worden ist. Aber wenn der Anwender zwischen den Fundstellen beliebig hin und herspringen möchte, sogar nach Belieben zur ersten, zur letzten Fundstelle?

Gut, lesen wir doch die Positionen der Fundstellen in ein Array ein. Sie machen das mit Ihrer Schleife und ich mache das mit den beiden folgenden Funktionen, die auf meinem Split-Trick beruhen. Die erste liefert die Positionen aller Fundstellen, die zweite berücksichtigt Worttrenner, kann also die Suche auf ganze Wörter beschränken. Der höchste Index des jeweils zurückgegebenen Arrays (das erste Element hat den Index 1) liefert zugleich die Anzahl der Fundstellen.

Public Function SubStringPositions(BaseString As String, _
 SubString As String, Optional ByVal Exact As Boolean) As Variant
  Dim nParts As Variant
  Dim nPositions() As Long
  Dim nPos As Long
  Dim nLenSubString As Long
  Dim l As Long
  Dim nCompare As VbCompareMethod
  
  Select Case Exact
    Case False
      nCompare = vbTextCompare
    Case True
      nCompare = vbBinaryCompare
  End Select
  nParts = Split(BaseString, SubString, , nCompare)
  If UBound(nParts) > 0 Then
    ReDim nPositions(1 To UBound(nParts))
    nLenSubString = Len(SubString)
    For l = 0 To UBound(nParts) - 1
      nPos = nPos + Len(nParts(l))
      nPositions(l + 1) = nPos + l * nLenSubString + 1
    Next
    SubStringPositions = nPositions
  End If
End Function

Public Function SubStringPositionsEx(BaseString As String, _
 SubString As String, Optional ByVal Exact As Boolean, _
 Optional FullWords As Boolean, Optional Delimiters As String) _
 As Variant

  Dim nDelimiters As String
  Dim nParts As Variant
  Dim nPositions() As Long
  Dim nLenSubString As Long
  Dim nPos As Long
  Dim l As Long
  Dim p As Long
  Dim nCompare As VbCompareMethod
  
  Select Case Exact
    Case False
      nCompare = vbTextCompare
    Case True
      nCompare = vbBinaryCompare
  End Select
  nParts = Split(BaseString, SubString, , nCompare)
  If UBound(nParts) > 0 Then
    If Not FullWords Then
      SubStringPositionsEx = SubStringPositions(BaseString, _
                              SubString, Exact)
      Exit Function
    Else
      If Len(Delimiters) = 0 Then
        nDelimiters = DefaultDelimiters
      Else
        nDelimiters = Delimiters
      End If
    End If
    ReDim nPositions(1 To UBound(nParts))
    nLenSubString = Len(SubString)
    For l = 0 To UBound(nParts) - 1
      nPos = nPos + Len(nParts(l))
      If InStr(nDelimiters, Right$(nParts(l), 1)) Then
        If InStr(nDelimiters, Left$(nParts(l + 1), 1)) Then
          p = p + 1
          nPositions(p) = nPos + l * nLenSubString + 1
        End If
      End If
    Next
    If p Then
      ReDim Preserve nPositions(1 To p)
      SubStringPositionsEx = nPositions
    End If
  End If
End Function

Im letzten optionalen Parameter der Funktion SubStringPositionsEx können Sie auch einen eigenen String angeben, der aus den zu berücksichtigenden Trennzeichen zusammengesetzt ist.

Wenn Sie den Standard-String der Trennzeichen anderweitig brauchen können, oder diesen ändern möchten, erhalten Sie ihn von der Eigenschaft DefaultDelimiter (kein Problem - ein Standard-Modul kann auch Eigenschaften haben!).

Public Property Get DefaultDelimiters() As String
  DefaultDelimiters = " ,;.:-_+*<>?\=})]([/{&%$!@" & Chr$(34) & vbCrLf
End Property

Wenn Sie aus diesem String einzelne Trennzeichen ausschließen möchten, können Sie das mit der Funktion ExcludeDelimiter erreichen:

Public Function ExcludeDelimiter(Delimiters As String, _
 Exclude As String) As String

  ExcludeDelimiter = Replace(Delimiters, Exclude, "")
End Function

Für frühere Visual Basic-Versionen müssten Sie die Split- und die Replace-Funktion (letztere wird hier nur in der Funktion ExcludeDelimiter verwendet) durch eigene Implementierungen ersetzen (siehe z.B. "Teile-Haberschaft"). Allerdings könnte es dann sein, dass Ihre eigenen Schleifen-Implementierungen anstelle meiner Funktionen dieses Artikels doch ein wenig effizienter und schneller wären...

Copyright © 1999 - 2011 Harald M. Genauck, ip-pro gmbh  /  Impressum