|
Die Funktion InStr liefert Ihnen die Position des Vorkommens eines Strings in einem anderen String, entweder ab dem Anfang oder hinter einer anzugebenden Startposition. Wenn Sie allerdings erst das "soundsovielte" Vorkommen interessiert, müssen Sie selbst mitzählen. Die folgende Funktion InStrOccur ("Occurence", engl. für "Vorkommen") erspart Ihnen die Zählerei:
Public Function InStrOccur(Text As String, Find As String, _
Optional ByVal Occurence As Long, _
Optional ByVal Start As Long = 1, _
Optional CompareMethod As VbCompareMethod = vbBinaryCompare) _
As Long
Dim nOccur As Long
Dim nPos As Long
Dim nStart As Long
Select Case Occurence
Case Is > 0
nStart = Start
Do
nPos = InStr(nStart, Text, Find, CompareMethod)
If nPos Then
nOccur = nOccur + 1
If nOccur = Occurence Then
InStrOccur = nPos
Exit Function
End If
nStart = nPos + 1
Else
Exit Do
End If
Loop
Case Else
Err.Raise 5
End Select
End Function
Natürlich gibt es auch den Rückwärtsgang, der den gegebenen String von hinten her durchsucht. In Visual Basic 6 können Sie dazu auf die recht schnelle InStrRev-Funktion zurückgreifen:
Public Function InStrRevOccur(Text As String, Find As String, _
Optional ByVal Occurence As Long, _
Optional ByVal Start As Variant, _
Optional CompareMethod As VbCompareMethod = vbBinaryCompare) _
As Long
Dim nOccur As Long
Dim nPos As Long
Dim nStart As Long
Select Case Occurence
Case Is > 0
If IsMissing(Start) Then
nStart = Len(Text)
Else
nStart = Start
End If
Do
nPos = InStrRev(Text, Find, nStart, CompareMethod)
If nPos Then
nOccur = nOccur + 1
If nOccur = Occurence Then
InStrRevOccur = nPos
Exit Function
End If
nStart = nPos - 1
Else
Exit Do
End If
Loop
Case Else
Err.Raise 5
End Select
End Function
In Visual Basic 5 brauchen Sie hingegen einen eigenen Algorithmus, der zuerst alle Vorkommen ermitteln muss, um dann das "soundsovielte" Vorkommen von der Gesamtzahl aus gesehen herauszufischen:
Public Function InStrRevOccur5(Text As String, Find As String, _
Optional ByVal Occurence As Long, _
Optional ByVal Start As Variant, _
Optional CompareMethod As VbCompareMethod = vbBinaryCompare) _
As Long
Dim nOccurences() As Long
Dim nPos As Long
Dim nStart As Long
Dim nOccurence As Long
Dim nOccur As Long
Dim nText As String
Select Case Occurence
Case Is > 0
ReDim nOccurences(1 To 10)
nStart = 1
If IsMissing(Start) Then
nText = Text
Else
nText = Left$(Text, nStart)
End If
Do
nPos = InStr(nStart, nText, Find, CompareMethod)
If nPos Then
nOccur = nOccur + 1
If nOccur > UBound(nOccurences) Then
ReDim Preserve nOccurences(1 To UBound(nOccurences) + 10)
End If
nOccurences(nOccur) = nPos
nStart = nPos + 1
Else
Exit Do
End If
Loop
nOccurence = nOccur - Occurence + 1
If nOccurence >= 1 Then
InStrRevOccur5 = nOccurences(nOccurence)
End If
Case Else
Err.Raise 5
End Select
End Function
|