[AccessD] Count the occurrences of each character in a string

Stuart McLachlan stuart at lexacorp.com.pg
Wed Sep 7 05:41:09 CDT 2022

```Sorry. PB = PowerBASIC. I re-wrote the VBA to use with my PowerBASIC compiler.

It's just a minor modification  which  replaces the  very similar block in the original post.
ie. the function will be as follows.  (It's just the insertion of an IF...Then construct around the
"y" loop.)

Function Lettercount(sInputString As String, CaseSensitive As Boolean) As Long
Dim lStr As Long, x As Long, y As Long, compare As Long
Dim sTxt As String
Dim freq() As Long

'Initialise
sTxt = sInputString 'we are going to modify the string!
If CaseSensitive = True Then
compare = vbBinaryCompare
Else
compare = vbTextCompare
End If
lStr = Len(sTxt)
ReDim freq(1 To lStr)

'Get the letter counts
For x = 1 To lStr
If Asc(Mid\$(sTxt, x, 1)) <> 0 Then ' skip over the "y" loop if character is already zeroed
freq(x) = 1
For y = x + 1 To lStr
If StrComp(Mid\$(sTxt, x, 1), Mid\$(sTxt, y, 1), compare) = 0 Then
freq(x) = freq(x) + 1
Mid\$(sTxt, y, 1) = Chr\$(0)
End If
Next
End If        ' End of skipping over the "y" loop
Next

'Display the results
For x = 1 To lStr
If Mid\$(sTxt, x, 1) <> Chr\$(0) Then
Debug.Print Mid\$(sTxt, x, 1) & "  -  " & str\$(freq(x))
End If
Next
End Function

On 7 Sep 2022 at 5:56, Arthur Fuller wrote:

> Hi Stuart,
>
> I don't know what a PB function is. Also, I'm not sure where to place
> this new code.
>
> On Wed, Sep 7, 2022 at 3:13 AM Stuart McLachlan
> <stuart at lexacorp.com.pg> wrote:
>
> > Just converted this to a PB function and in doing so, I realised
> > that it was slower than necessary. With a large string you will save
> > a LOT of iterations with
> >
> > For x = 1 To lStr
> >        If Asc(Mid\$(sTxt, x, 1)) <> 0 Then
> >             freq(x) = 1
> >             For y = x + 1 To lStr
> >                 If StrComp(Mid\$(sTxt, x, 1), Mid\$(sTxt, y, 1),
> >                 compare) =
> > 0 Then
> >                     freq(x) = freq(x) + 1
> >                     Mid\$(sTxt, y, 1) = Chr\$(0)
> >                End If
> >             Next
> >        End If
> > Next
> >

```