Re: Number of occurances

Tech Tip: Click here to run a free scan for Windows Errors and optimize PC performance

I think that is it. Can't see it working with Mid$.

RBS

"RB Smissaert" <bartsmissaert@xxxxxxxxxxxxxxxx> wrote in message news:%23VrEunHnGHA.4240@xxxxxxxxxxxxxxxxxxxxxxx
Yes, it looks a function based on Instr is much faster indeed:


Function CountString4(strChar As String, _
strString As String) As Long

If InStr(1, strString, strChar, vbBinaryCompare) = 0 Or _
Len(strString) = 0 Then
CountString4 = 0
Exit Function
End If

Dim lPos As Long
Dim n As Long

lPos = InStr(1, strString, strChar, vbBinaryCompare)

Do Until lPos = 0
lPos = InStr(lPos + 1, strString, strChar, vbBinaryCompare)
n = n + 1
Loop

CountString4 = n

End Function


Will look at Mid$ now.


RBS


"RB Smissaert" <bartsmissaert@xxxxxxxxxxxxxxxx> wrote in message news:%23OqVviHnGHA.4648@xxxxxxxxxxxxxxxxxxxxxxx
Funny, just did some timing myself.
Admittedly, with a short string there isn't much in it, but I found the one with the Byte array the fastest,
second the one based on Split and third the one based on Replace.
Not tested yet, but I think with longer strings the one based on the Byte array gets relatively faster.
This is my code:


Option Explicit
Private Declare Function timeGetTime Lib "winmm.dll" () As Long
Private lStartTime As Long

Sub Tester()

Dim i As Long
Dim strTest As String
Dim lCount As Long

strTest = "12, 131, 32, 131, 434, 53, 23"

StartSW
For i = 1 To 100000
lCount = CountString3(",", strTest)
'lCount = CountString1(44, strTest)
Next
StopSW

MsgBox lCount

End Sub

Function CountString1(btAscChar As Byte, _
strString As String) As Long

Dim i As Long
Dim n As Long
Dim btArray() As Byte

If InStr(1, strString, Chr(btAscChar), vbBinaryCompare) = 0 Or _
Len(strString) = 0 Then
CountString1 = 0
Exit Function
End If

btArray = strString

For i = 0 To UBound(btArray) - 1 Step 2
If btArray(i) = btAscChar Then
n = n + 1
End If
Next

CountString1 = n

End Function

Function CountString2(strChar As String, _
strString As String) As Long

Dim strTemp As String

If InStr(1, strString, strChar, vbBinaryCompare) = 0 Or _
Len(strString) = 0 Then
CountString2 = 0
Exit Function
End If

strTemp = strString

CountString2 = Len(strString) - Len(Replace(strString, strChar, vbNullString))

End Function

Function CountString3(strChar As String, _
strString As String) As Long

If InStr(1, strString, strChar, vbBinaryCompare) = 0 Or _
Len(strString) = 0 Then
CountString3 = 0
Exit Function
End If

Dim arr

arr = Split(strString, strChar, , vbBinaryCompare)

CountString3 = UBound(arr)

End Function

Sub StartSW()
lStartTime = timeGetTime()
End Sub

Sub StopSW(Optional ByRef strMessage As Variant = "")
MsgBox "Done in " & timeGetTime() - lStartTime & " msecs", , strMessage
End Sub

You made the one based on Split slower by doing this:
Erase arTest
Don't think you have to do that.

Just thinking, maybe it can be made faster by repeatedly running a Mid$ or Instr.
Or maybe even faster by working with pointers.


RBS


"Dmitriy Antonov" <antonovdima@xxxxxxxxxxxxxxxxxxxxxxxx> wrote in message news:uRSnWXHnGHA.4104@xxxxxxxxxxxxxxxxxxxxxxx

"RB Smissaert" <bartsmissaert@xxxxxxxxxxxxxxxx> wrote in message news:%23LNLlIHnGHA.4816@xxxxxxxxxxxxxxxxxxxxxxx
Well, I have tested and it is much faster.

Is it really "much".

This is my test. I used some home-made timer (based on someone else snippets signed as CTimingPC - (c) don 19990921, donald@xxxxxxxxx). If you try to reproduce it, then you need to replace it with something else (maybe Timer would suffice)

Private Sub Command1_Click()
Dim sTm$
Dim sText$
Dim arTest As Variant
Dim tm As AntTimer.clsTiming
Dim lRpt&, i&
Dim lRes As Long
Dim sRes As String
Set tm = New AntTimer.clsTiming
sText = "12, 131, 32, 131, 434, 53, 23"

lRpt = 100000

tm.Reset
For i = 1 To lRpt
lRes = Len(sText) - Len(Replace(sText, ",", vbNullString))
Next i
sTm = tm.sElapsed
sRes = sRes & "; Replace: " & sTm

tm.Reset
For i = 1 To lRpt
arTest = Split(sText, ",")
lRes = UBound(arTest) + 1
Next i
Erase arTest
sTm = tm.sElapsed
sRes = sRes & "; Split: " & sTm

Debug.Print Mid$(sRes, 2)
End Sub

And these are results of some calls:
Replace: 459.551 msec; Split: 514.044 msec
Replace: 454.752 msec; Split: 522.686 msec
Replace: 462.284 msec; Split: 516.729 msec
Replace: 453.051 msec; Split: 521.551 msec
Replace: 460.043 msec; Split: 516.254 msec
Replace: 454.801 msec; Split: 521.006 msec
Replace: 458.420 msec; Split: 512.191 msec


As you can see Replace is faster, but not significantly (note - it is after 100'000 repetitions).

If you use "" instead of vbNullString then results are like this:

Replace: 535.667 msec; Split: 520.965 msec
Replace: 553.209 msec; Split: 523.925 msec
Replace: 538.369 msec; Split: 518.117 msec
Replace: 554.293 msec; Split: 522.674 msec
Replace: 538.168 msec; Split: 516.176 msec
Replace: 552.129 msec; Split: 519.346 msec

Now Split is better, but, again, can't talk about "much", but rather - "insignificantly". This BTW, shows effect of using vbNullString versus empty string.- pretty noticeable for such a simple replacement.

I didn't test it in a compiled version, but I am sure relative difference should remain about the same.

BTW, you forgot to add explicit delimiter

Yes, that is what you get if you post air-code.
Suppose should always run before posting and that is what I used to do.

It wouldn't help in this particular case, because, as I said, each group in a sample includes a space, so final result would be the same, even having logic error.

Dmitriy.




.

Relevant Pages

  • Project Error
    ... Private Declare Sub Sleep Lib "Kernel32" ... Dim strDataSrc As String ...
    (microsoft.public.vb.bugs)
  • Re: Is there a way to prevent a RichTextBox from scrolling?
    ... Private _isRegex As Boolean ... Public Sub New(ByVal thispattern As String, ... Dim entry As tDict ...
    (microsoft.public.dotnet.framework.windowsforms.controls)
  • Excel Listing tool using VB
    ... Sub ListFiles2() ... Dim directories() As String, CurrentDirectory As String ... Dim dirtopaste, dirok ...
    (microsoft.public.vb.general.discussion)
  • Form Error
    ... SMSDS_CallerID As String ... Private Declare Sub Sleep Lib "kernel32" ... Dim ComString As String ... Dim AppPath As String, FreeFileNo% ...
    (microsoft.public.vb.bugs)
  • Re: Encrypt/hide Password
    ... Public Sub New(ByVal strCryptoName As String) ... ' instantiated crypto class. ... Dim fsKey As New FileStream(strSaveToPath, FileMode.OpenOrCreate, _ ...
    (microsoft.public.scripting.wsh)