A few months ago i posted the below post on a different blog. Since this is my dedicated programming blog, I thought I’d bring it over here. I commonly need to return the number of a specific character in a string, and was never really happy with what i found on the internet. Here are some concepts of different ways to do it.
Function cnt_occ1(ByRef sIn As String, ByRef sFor As String, Optional ByVal casesensitive As Boolean = False) As Integer
Dim startTime As DateTime = DateTime.Now
Dim ts As String = “”
If casesensitive Then
ts = sIn.Replace(sFor, “”)
Else
ts = sIn.Replace(sFor.ToUpper, “”).Replace(sFor.ToLower, “”)
End If
Dim executionTime As TimeSpan = DateTime.Now – startTime
MsgBox(executionTime.Seconds.ToString() & “:” & executionTime.Milliseconds.ToString())
Return sIn.Length – ts.Length
End Function
Function cnt_occ2(ByRef OrigString As String, ByVal Chars As String, Optional ByVal CaseSensitive As Boolean = False) As Integer
Dim startTime As DateTime = DateTime.Now
‘http://www.freevbcode.com/ShowCode.Asp?ID=1025
Dim lLen As Long
Dim lCharLen As Long
Dim lAns As Long
Dim sInput As String
Dim sChar As String
Dim lCtr As Long
Dim lEndOfLoop As Long
Dim bytCompareType As Byte
sInput = OrigString
If sInput = “” Then Return 0
lLen = Len(sInput)
lCharLen = Len(Chars)
lEndOfLoop = (lLen – lCharLen) + 1
bytCompareType = IIf(CaseSensitive, vbBinaryCompare, _
vbTextCompare)
For lCtr = 1 To lEndOfLoop
sChar = Mid(sInput, lCtr, lCharLen)
If StrComp(sChar, Chars, bytCompareType) = 0 Then lAns = lAns + 1
Next
Dim executionTime As TimeSpan = DateTime.Now – startTime
MsgBox(executionTime.Seconds.ToString() & “:” & executionTime.Milliseconds.ToString())
Return lAns
End Function
Function cnt_occ3(ByRef sIn As String, ByRef sFor As String, Optional ByVal casesensitive As Boolean = False) As Integer
Dim startTime As DateTime = DateTime.Now
Dim oc As Integer
Dim pos As Integer
Dim ts As String = “”
Dim lp As Integer
If casesensitive = False Then
ts = sIn.ToLower
sFor = sFor.ToLower
lp = ts.LastIndexOf(sFor)
Else
lp = sIn.LastIndexOf(sFor)
ts = sIn
End If
While 1 = 1
oc += 1
pos = ts.IndexOf(sFor, pos) + 1
If pos >= lp Then
Exit While
End If
End While
Dim executionTime As TimeSpan = DateTime.Now – startTime
MsgBox(executionTime.Seconds.ToString() & “:” & executionTime.Milliseconds.ToString())
Return oc
End Function
Function cnt_occ4(ByRef sIn As String, ByRef sFor As String, Optional ByVal casesensitive As Boolean = False) As Integer
Dim startTime As DateTime = DateTime.Now
Dim oc As Integer
Dim ts As String = “”
If casesensitive = False Then
ts = sIn.ToLower
sFor = sFor.ToLower
Else
ts = sIn
End If
While 1 = 1
oc += 1
ts = ts.Substring(ts.IndexOf(sFor) + 1)
If ts.IndexOf(sFor) = -1 Then
Exit While
End If
End While
Dim executionTime As TimeSpan = DateTime.Now – startTime
MsgBox(executionTime.Seconds.ToString() & “:” & executionTime.Milliseconds.ToString())
Return oc
End Function
I thought that to count the occurrences of a character in a string I could replace it with nothing, then diff the lengths. Indeed it is faster. Surprisingly the 2nd fastest is looping through each character. Next we have the index of the string saved and looking for the next index of. Lastly we have the string cut for each occurrence.
Here’s the results:
Small number of occurrences-
1-0.46
2-0.93
3-0.812
4-5.640
Large number of occurrences-
1-0.31
2-0.93
3-4.843
4-34.508
key:
seconds.milliseconds
conclusion:
My code is not only always faster but it’s also much cleaner and readable. I’m sure someone else has done this but I hadn’t read about it before.
The code can then be reduced to:
Function cnt_occ(ByRef sIn As String, ByRef sFor As String, Optional ByVal casesensitive As Boolean = False) As Integer
If casesensitive Then
Return sIn.Length – sIn.Replace(sFor, “”).Length
Else
Return sIn.Length – sIn.Replace(sFor.ToUpper, “”).Replace(sFor.ToLower, “”).Length
End If
End Function
