|
Mit den VB-Funktionen  InStr und InstrRev (letztere ist erst ab Visual Basic 6 verfügbar) können Sie nach den Vorkommen eines Teils-Strings in einem anderen String suchen. Wenn Sie dabei optional die Vergleichsmethode (CompareMethod) auf vbTextCompare setzen, wird sogar die Groß-/Kleinschreibung ignoriert. Eine Suche nach einem allgemeineren Muster, etwa nach einem Teil-String, der "wie ein Datum aussieht", ist damit nicht möglich.
Die beiden folgenden Funktionen sind um eine solche Muster-Suche erweiterte Funktionen. InstrPattern sucht dabei wie InStr vom Anfang her, während InstrPatternRev wie InstrRev vom Ende her sucht. Bei beiden können Sie optional die Start-Position und auch die Vergleichsmethode angeben.
Um den für die Vergleichsoperation benötigten Operator Like mit der Text-Vergleichsmethode verwenden zu können, muss der Vergleichsvorgang in ein eigenes Modul ausgelagert werden, in dem die Vergleichsmethode mit einem modul-globalen "Option Compare Text" gesetzt ist. Ein solches Modul finden Sie im Download zum Artikel  "Like Binary oder Text".
Damit sich der Umfang und die Geschwindigkeit der Funktionen in Grenzen halten, kann im Suchmuster lediglich das Fragezeichen als Platzhalter im Suchmuster verwendet werden. Ein Suchmuster, das "*"-Zeichen enthält, würde wegen der variablen Längen den Rahmen sprengen.
Public Enum ispTextCompareConstants
ispBinaryCompare
ispTextCompare
End Enum
Public Function InstrPattern(Text As String, Pattern As String, _
Optional ByVal Start As Long = 1, _
Optional ByVal CompareMethod As ispTextCompareConstants) As Long
Dim l As Long
Dim nPatternLength As Long
Dim nTextLength As Long
Dim nLast As Long
If InStr(Pattern, "*") Then
Err.Raise 380
Else
nPatternLength = Len(Pattern)
nTextLength = Len(Text)
If nTextLength >= nPatternLength Then
nLast = nTextLength - nPatternLength + 1
Select Case CompareMethod
Case ispBinaryCompare
For l = Start To nLast
If Mid$(Text, l, nPatternLength) Like Pattern Then
InstrPattern = l
Exit Function
End If
Next 'l
Case ispTextCompare
For l = Start To nLast
If LikeCompText(Mid$(Text, l, nPatternLength), Pattern) _
Then
InstrPattern = l
Exit Function
End If
Next 'l
Case Else
Err.Raise 380
End Select
End If
End If
End Function
Public Function InstrPatternRev(Text As String, Pattern As String, _
Optional ByVal Start As Long = 1, _
Optional ByVal CompareMethod As ispTextCompareConstants) As Long
Dim l As Long
Dim nPatternLength As Long
Dim nTextLength As Long
Dim nLast As Long
If InStr(Pattern, "*") Then
Err.Raise 380
Else
nPatternLength = Len(Pattern)
nTextLength = Len(Text)
If nTextLength >= nPatternLength Then
nLast = nTextLength - nPatternLength + 1
Select Case CompareMethod
Case ispBinaryCompare
For l = nLast To Start Step -1
If Mid$(Text, l, nPatternLength) Like Pattern Then
InstrPatternRev = l
Exit Function
End If
Next 'l
Case ispTextCompare
For l = nLast To Start Step -1
If LikeCompText(Mid$(Text, l, nPatternLength), Pattern) _
Then
InstrPatternRev = l
Exit Function
End If
Next 'l
Case Else
Err.Raise 380
End Select
End If
End If
End Function
|