Tipp 8.8 - Zeichen ermitteln

Wie kann ich das Vorkommen eines oder mehrerer Zeichen in einem String ermitteln?

Mit dieser Funktion können Sie das Vorkommen eines oder mehrerer Zeichen in einem String ermitteln. Kopieren Sie einfach nachfolgenden Quellcode in die Zwischenablage und fügen Sie anschließend den Inhalt der Zwischenablage in ein neues Modul ein. Die Aufrufparameter finden Sie im Quellcode beschrieben.

Beispiel:

Option Explicit
 
Public Function CountEqualWords(sText As String, _
                                sFind As String, _
                                Optional lMethod _
                                As Long = vbTextCompare) _
                                As Long
  '// -----------------------------------------------------
  '// Methode:  | Vorkommen eines oder mehrerer Zeichen
  '//           | in einem String ermitteln
  '// -----------------------------------------------------
  '// Parameter:| sText - zu durchsuchender Text
  '//           | sFind - Suchkriterium
  '//           | lMethod - Vergleichsmethode
  '// -----------------------------------------------------
  '// Rückgabe: | Anzahl Treffer
  '// -----------------------------------------------------
  '// Autor:    | Stefan Kulpa
  '//           | EDV Innovation & Consulting - Dormagen
  '// -----------------------------------------------------
  '// Beispiel: |?CountEqualWords("Hallo Welt!", "l") = 3
  '//           |?CountEqualWords("Hallo Welt!", "ll") = 1
  '//           |?CountEqualWords("Hallo Welt!", "HALLO", _
   '//           |                  vbBinaryCompare) = 0
  '//           |?CountEqualWords("Hallo Welt!", "HALLO", _
   '//           |                  vbTextCompare) = 1
  '// -----------------------------------------------------
  Dim lPos      As Long
  Dim lTemp     As Long
  Dim lCount    As Long
 
  lPos = 1
  On Error GoTo Err_CountEqualWords
  If lMethod <> vbTextCompare And _
      lMethod <> vbBinaryCompare Then _
      lMethod = vbTextCompare
  Do
    lPos = InStr(lPos, sText, sFind, lMethod)
    lTemp = lPos
    If lPos > 0 Then
      lCount = lCount + 1
      lPos = lPos + Len(sFind)
    End If
  Loop Until lPos = 0
  CountEqualWords = lCount
 
Err_CountEqualWords:
  Exit Function
 
End Function


Zurück Tipp 8.7 - Alphanumerisches Zeichen prüfen | Inhalt | Tipp 8.9 - Hex-Wert nach Long Weiter