COUNTING CHARACTERS

[gsc1ugs]

Hi All

Does VB have a function to count each character of the alphabet in a document;

ie:

How many of each letter in the doc without codeing for each instance myself.

Cheers Gary

Well this is a small search function and it'll return the number of times something occurs in a string, I guess you'd have to call it 26 times.

Private Function occurred(ByVal searched As String, ByVal searchstr As String) As Integer
Dim pos, count As Integer
Do
    pos = InStr(pos + 1, searched, searchstr)
    If pos <> 0 Then count = count + 1
Loop Until pos = 0
occurred = count
End Function

Sunny

[gsc1ugs]

What params do you give it?

Private Function occurred(ByVal searched As String, ByVal searchstr As String) As Integer

You pass:
searched - the string being searched (you'd have to load the document)
searchstr - the string being sought


eg:

Dim str As String

str = "Testing123Testing"

Text1.Text = occurred(str, "123")

The result in the textbox should be one.

Sunny

[gsc1ugs]

If you fancy a challenge:

Here's my code with the occurred function introduced. What i would like to do is have an occurence for every letter of the alphabet and report the results the the text dialog, i'll give it a go but every little helps.

code:
----------------------------------------------------------
Option Explicit
Dim fileLocal
Dim FileNameLocal As String

Private Sub Command1_Click()
ReadFile
End Sub

Private Sub Form_Load()
DriveLetter.AddItem "c:"
DriveLetter.AddItem "d:"
DriveLetter.AddItem "e:"
End Sub

Private Sub ReadFile()
Dim szTemp As String
Dim lne$
fileLocal = FreeFile
szTemp = DriveLetter + "\" + "temp" + "\" + ReadText.Text
FileNameLocal = szTemp
Open FileNameLocal For Input As #fileLocal
Do
Line Input #fileLocal, lne$ 'read first line
Debug.Print lne$
szTemp = szTemp + lne$
Result.Text = occurred(szTemp, "o")
Loop Until EOF(fileLocal) 'use f to locate end of fil
Close #fileLocal
End Sub

'count numbers of chars occurs
Private Function occurred(ByVal searched As String, ByVal searchstr As String) As Integer
Dim pos, count As Integer
Do
pos = InStr(pos + 1, searched, searchstr)
If pos <> 0 Then count = count + 1
Loop Until pos = 0
occurred = count + " " + searchstr
End Function

[jbart]

I played around with this a bit and if you want just a count of how many times each letter of the alphabet occurs, try this code. Use sunnyl's function with one change to convert the string to lowercase.

Option Explicit

Private Sub Command1_Click()
    Dim curChar As String
    Dim counter As Integer
    curChar = "a"
    For counter = 1 To 26
        Debug.Print curChar & " " & occurred(Text1.Text, curChar)
        curChar = Chr(Asc(curChar) + 1)
    Next counter
End Sub

Private Function occurred(ByVal searched As String, ByVal searchstr As String) As Integer
Dim pos, count As Integer

searched = lcase(searched)
Do
    pos = InStr(pos + 1, searched, searchstr)
    If pos <> 0 Then count = count + 1
Loop Until pos = 0
occurred = count
End Function

[gsc1ugs]

FLIPPINE ECK!... that was quick. cheers

[gsc1ugs]

I have this procedure to get a line by line read, how do i get the whole contents inot one string? i'm not a wiz with VB.

[gsc1ugs]

How do a apply newline to this?

Debug.Print curChar & " " & occurred(Result.Text, curChar)

[jbart]

If you are just needing to count the occurrences in a short "txt" file, this code should work. You just read the txt file into the textbox and run the count on the contents. If you need to read word documents, I am not sure how that would work.

Private Sub command2_click()
    Open "C:\personel.txt" For Input As #1
    Text1.Text = Input$(LOF(1), #1)
    Close #1
    Dim curChar As String
    Dim counter As Integer
    curChar = "a"
    For counter = 1 To 26
        Debug.Print curChar & " " & occurred(Text1.Text, curChar)
        curChar = Chr(Asc(curChar) + 1)
    Next counter
End Sub

[Edited by jbart on 10-09-2000 at 10:31 AM]

[gsc1ugs]

How do a apply newline to this?

Debug.Print curChar & " " & occurred(Result.Text, curChar)

You can use vbCrlf.

str = curChar & " " & occurred(Result.Text, curChar) & vbCrlf

This would give something like:
a 1
b 2
c 3

Sunny

[gsc1ugs]

Already done it, i give the text box the horizontal scroll so enabling auto-wrap, many thanks anyhow.

Gary

[kedaman]

therefore, here's something faster:

Dim buffer() as byte,x&,ascii&(255) 
Open File for binary as #1
  Get#1,,buffer
close #1
For X=0 ubound(buffer)
  ascii(buffer(x))=ascii(buffer(x))+1
next X

It will open the file, read it into a byte array and then go trough it once, adding all ascii chars amount into one array.

Now to get the amount of "A"'s you can do
debug.print ascii(asc("A"))

[HughLacey]

You may want to look at the scripting runtime to read the file into a string.

The following code reads a text file into a string and returns a variant array with each element containing the frequncy of that character in the string eg:

Frequency(Asc("A")) is the number of A's in the string

Option Explicit

Public Sub Main()

Dim Frequency As Variant
Dim c As Integer

Frequency = GetFrequencyDistribution(ReadFileIntoString("C:\INSTALL.LOG"))
For c = 0 To 255
Debug.Print "Frequency of Character " & CStr(c) & " = "; Frequency(c)
Next c

End Sub

Private Function GetFrequencyDistribution(s As String) As Variant

Dim c As Integer

For c = 0 To 255
GetFrequencyDistribution = GetFrequencyDistribution & Format$(CountOccurance(s, Chr$(c)))
If c < 255 Then GetFrequencyDistribution = GetFrequencyDistribution & ","
Next c
GetFrequencyDistribution = Split(GetFrequencyDistribution, ",")

End Function

Private Function ReadFileIntoString(FileName As String) As String
Dim fso As Scripting.FileSystemObject
Dim ts As Scripting.TextStream

Set fso = New Scripting.FileSystemObject
Set ts = fso.OpenTextFile(FileName, ForReading, False, TristateFalse)
ReadFileIntoString = ts.ReadAll
ts.Close
End Function

Private Function CountOccurance(ByVal s As String, c As String) As Integer
CountOccurance = (Len(s) - Len(Replace(s, c, ""))) / Len(c)
End Function