Tento krátký řetězec kódu je chopen spočítat výskyt řetězců v textu.
Kód je velice snadný, prochází řetězec znak po znaku a reaguje na výstupní změnu funkce InStr.
Private Sub Command1_Click()
Dim strProhledavany As String
Dim strHledany As String
Dim lngLen As Long
Dim lngTemp As Long
Dim retPosition As Long
Dim lngPocet As Long
strProhledavany = Text1.Text
strHledany = Text2.Text
lngLen = Len(strProhledavany)
For i = 1 To lngLen
retPosition = InStr(i, strProhledavany, strHledany, vbTextCompare)
If retPosition = 0 Then Exit For
If lngTemp <> retPosition Then lngPocet = lngPocet + 1
lngTemp = retPosition
Next i
Print Val(lngPocet)
End Sub
Počet průchodu cyklu lze snadno omezit, stačí se vždy posunout na místo, kde se dohledalo, a počet cyklů bude roven počtu nalezených znaků.
Private Sub Command1_Click()
Dim strProhledavany As String
Dim strHledany As String
Dim lngLen As Long
Dim lngTemp As Long
Dim retPosition As Long
Dim lngPocet As Long
strProhledavany = Text1.Text
strHledany = Text2.Text
lngLen = Len(strProhledavany)
For i = 1 To lngLen
retPosition = InStr(i, strProhledavany, strHledany, vbTextCompare)
If retPosition = 0 Then Exit For
If lngTemp <> retPosition Then lngPocet = lngPocet + 1: i = retPosition
lngTemp = retPosition
Next i
Print Val(lngPocet)
End Sub
Při použití této úpravy lze ušetřit spoustu času v závislosti na délce prohledávaného řetězce. Toto lze ovšem vyřešit i elegantněji bez použití tempu.
Private Sub Command1_Click()
Dim strProhledavany As String
Dim strHledany As String
Dim lngLen As Long
Dim retPosition As Long
Dim lngPocet As Long
strProhledavany = Text1.Text
strHledany = Text2.Text
lngLen = Len(strProhledavany)
For i = 1 To lngLen
retPosition = InStr(i, strProhledavany, strHledany, vbTextCompare)
If retPosition = 0 Then Exit For
lngPocet = lngPocet + 1
i = retPosition
Next i
Print Val(lngPocet)
End Sub
To by tedy bylo několik různě řešených kódů pro prohledávání řetězců, z nichž poslední je bezesporu nejvýhodnější a první dva slouží jako ukázky jiného možného postupu.