Re: How to replace a string of characters with the count of the ch

Tech-Archive recommends: Speed Up your PC by fixing your registry

Hi Russ

Hmmm. The routine terminates with a msgbox that says "0Y" which seems like
it's proclaiming success ("OY!") but I have my doubts.

I'm assuming that it's designed to work on a string such as:

9 0 3 5 10 3 2 6 5 0 0 7 1 6 9 0 0 5 5 7 2 1 4 0 1 0

and to output:

9A3 5 10 3 2 6 5B7 1 6 9B5 5 7 2 1 4A1A.

I thought that I'd misunderstood the purpose and that maybe it was intended
to be applied to the original plain text, so I ran it against:

I wandered lonely as a cloud, that floats on high o’er vales and hills,
etc., etc., with a few 12345 thrown in for good measure!

But still it says "0Y"

Or is it complaining: "Oh, why?" :)

Best,

Peter

"Russ" wrote:

Peter,
This should work:

Public Sub AlphabetCountString()
Dim CharNum As Long
Dim AlphabetCountString As String
Dim aRange As Word.Range
Dim ZeroString As String
If Selection.Type = wdSelectionIP Then 'No text selected?
Set aRange = ActiveDocument.Content 'then work on whole main body
Else
Set aRange = Selection.Range
End If

For CharNum = Asc("A") To Asc("Z")
AlphabetCountString = AlphabetCountString & UBound(Split(aRange, _
Chr$(CharNum), vbTextCompare)) & " "
Next CharNum
ZeroString = " 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0"
For CharNum = 26 To 1 Step -1
AlphabetCountString = Replace(AlphabetCountString, _
Left(ZeroString, CharNum * 2) & " ", Chr$(64 + CharNum))
Next CharNum
MsgBox AlphabetCountString
End Sub

Hi Russ

Thanks for your input - it's always useful to see different ways of
achieving the same goal.

How would you generalise the Replace(AlphabetCountString, " 0 ", "A")
... Replace(AlphabetCountString, " 0 0 0 ", "C") ..., bearing in mind that
the theoretical space allows for coding a run of 26 zeros (i.e Z)?

Best,

Peter

"Russ" wrote:

Peter,
Fixed the typo in the spelling of Alphabet below and added choice of
selected text or whole document content, if nothing is selected:

Public Sub AlphabetCountString()
Dim CharNum As Long
Dim AlphabetCountString As String
Dim aRange As Word.Range

If Selection.Type = wdSelectionIP Then 'No text selected?
Set aRange = ActiveDocument.Content 'then work on whole main body
Else
Set aRange = Selection.Range
End If

For CharNum = Asc("A") To Asc("Z")
AlphabetCountString = AlphabetCountString & UBound(Split(aRange, _
Chr$(CharNum), vbTextCompare)) & " "
Next CharNum
AlphabetCountString = Replace(AlphabetCountString, " 0 0 0 ", "C")
AlphabetCountString = Replace(AlphabetCountString, " 0 0 ", "B")
AlphabetCountString = Replace(AlphabetCountString, " 0 ", "A")
MsgBox AlphabetCountString
End Sub



Peter,
This gets you closer to what you wanted:

Public Sub AlphabetCountString()
Dim CharNum As Long
Dim AlpahbetCountString As String
For CharNum = Asc("A") To Asc("Z")
AlpahbetCountString = AlpahbetCountString &
UBound(Split(ActiveDocument.Content, _
Chr$(CharNum), vbTextCompare)) & " "
Next CharNum
AlpahbetCountString = Replace(AlpahbetCountString, " 0 0 0 ", "C")
AlpahbetCountString = Replace(AlpahbetCountString, " 0 0 ", "B")
AlpahbetCountString = Replace(AlpahbetCountString, " 0 ", "A")
MsgBox AlpahbetCountString
End Sub

Peter,
Another way to get a speedy letter count without changing the document is
to
use my new favorite function combination that I first saw used by Helmut
Weber. Using Jay's method to loop through the alphabet:

Public Sub LetterCount()
Dim CharNum As Long
For CharNum = Asc("A") To Asc("Z")
MsgBox Chr$(CharNum) & " = " & UBound(Split(ActiveDocument.Content, _
Chr$(CharNum), vbTextCompare))
Next CharNum
End Sub


The vbTextCompare tells it to ignore case, otherwise use vbBinaryCompare.
Another neat thing about the Ubound(Split()) is that it can also count
longer strings such as words or phrases.

Hi Jay

I wrote a moderately long reply but it seems to have gone AWOL - not sure
of
the lag time between sending in something and having it appear in the
threads...

Anyway, at the risk of duplicating posts, I wanted to make sure I
registered
my thanks and appreciation for your solution - my VB skills are very rusty
but I can appreciate a bit of crisp coding when I see it :)

In the interim I'd played around with MoveEndWhile and MoveStart but found
that Selection.Characters.Count somehow ended up with a value of 1 if
nothing
was found, leading to an incorrect output. But since your solution is not
only correct but much faster than mine I'm happy to cease pursuing that
line
of investigation :)

My next task is to make the output a little more sophisticated (read:
complicated), by (i) converting runs of zeros into letters (A for 0, B for
0
0, C for 0 0 0, etc), (ii) closing the gaps between the resulting letters
and
numbers (but retaining spaces between numbers), so:

9 0 3 5 10 3 2 6 5 0 0 7 1 6 9 0 0 5 5 7 2 1 4 0 1 0

becomes:

9A3 5 10 3 2 6 5B7 1 6 9B5 5 7 2 1 4A1A

and finally (iii) dividing the [A-Z] source text into blocks of 125
characters if it exceeds 125, and processing each block independently.

I'm going to give that a bash but I suspect I may be back again before
long...:)

Once again, many thanks for your help.

Best,

Peter





"Jay Freedman" wrote:

Hi Peter,

I prefer to work with Range objects instead of the Selection whenever
possible, but in general this working example follows your outline except
for the final loop. I did have some trouble at first while trying to use
the
same range for the loop as I had used for the preceding manipulations --
it
seemed unable to find anything -- but it all cleared immediately when I
started with a fresh range (oRg2) at that point.

Note that there's an entirely different scheme at
http://www.word.mvps.org/FAQs/MacrosVBA/NoTimesTextInDoc.htm, and another
at
http://www.word.mvps.org/FAQs/MacrosVBA/GetNoOfReplacements.htm. With
either
of those, it would be better to record the resulting numbers in a
separate
document, instead of in-place replacement.

Sub CountChars()
Dim oRg As Range, oRg2 As Range
Dim CharNum As Long

Set oRg = ActiveDocument.Range

oRg.Case = wdUpperCase

With oRg.Find
.Format = False
.Forward = True
.Wrap = wdFindStop
.MatchWildcards = True

.Text = "[!A-Z]"
.Replacement.Text = ""
.Execute Replace:=wdReplaceAll

.Text = "([A-Z])"
.Replacement.Text = "\1^p"
.Execute Replace:=wdReplaceAll
End With

oRg.Sort

Set oRg = ActiveDocument.Range
With oRg.Find
.Format = False
.Forward = True
.Wrap = wdFindStop
.MatchWildcards = False

.Text = "^p"
.Replacement.Text = ""
.Execute Replace:=wdReplaceAll
End With

Set oRg2 = ActiveDocument.Range
With oRg2.Find
.Format = False
.Forward = True
.Wrap = wdFindStop
.MatchWildcards = True
For CharNum = Asc("A") To Asc("Z")
.Text = "([" & Chr$(CharNum) & "]{1,})"
If .Execute Then
oRg2.Text = oRg2.Characters.Count & " "
Else
oRg2.Text = "0 "
End If
oRg2.Collapse wdCollapseEnd
Next CharNum
End With
End Sub

--
Regards,
Jay Freedman
Microsoft Word MVP FAQ: http://word.mvps.org
Email cannot be acknowledged; please post all follow-ups to the newsgroup
so
all may benefit.

Ancient Brit wrote:
I have what seemed at first to be a trivial task for a Word 2003 SP2
macro (VB 6.3).

Given a body of text containing a range of characters (letters (upper
and lower case), digits, punctuation, spaces), all but the letters
A-Z need to be removed, then the resulting text needs to be sorted,
and finally, the count of each letter should replace each block of
sorted letters.

So: "I wandered lonely as a cloud, that floats on high o'er vales and
hills, etc., etc., with a few 12345 thrown in for good measure!"
becomes penultimately:


"AAAAAAAAACCCDDDDDEEEEEEEEEEFFFGGHHHHHHIIIIILLLLLLLMNNNNNNOOOOOOOOORRRRRSSS>>


S
STTTTTTTUUVWWWWY"
and then finally: 9 0 3 5 10 3 2 6 5 0 0 7 1 6 9 0 0 5 5 7 2 1 4 0 1
0. (The zeros appear where a letter in the sequence is missing and so
the count for that letter is zero).

I did some searching around and found very useful information on the
use of Search/Replace with wildcards from Graham Mayor and Klaus
Linke at word.mvps.org (excellent job - thank you!. I've been using
MS Word for probably 15 years and I still find something to learn :))

My initial code worked OK - my approach was to first select the
entire body of text and render it upper case, then use Search/Replace
with the FIND wildcard sequence [!A-Z] and the REPLACE sequence null
to reduce the text to solely A-Z.

A subsequent Search/Replace on the text added a carriage return after
every character, the result was sorted, followed by another
Search/Replace to remove all the carriage returns. (There may be a
quicker/simpler way but I'm not aware of it.)

When it came to replacing each block of the same letter with its
count, I hit a snag. Try as I might, I cannot find a simple
programmatic way to do what I want.

I thought I had a solution when I tested a manual approach, using
FIND with Highlight checked (so the count is returned, but more
importantly the block of matching text is selected on exiting FIND,
so that - I thought - I could just replace the selection with the
contents of Selection.Characters.Count (and add a space as a
separator).

Not so. What works manually doesn't appear to work in a macro.

If I create a macro (even if I record one) that uses FIND to locate
and select all matching characters, upon completion only the first
character in the group is selected, whether I use Selection or Range.

I haven't found a bug report that describes the FIND problem - yet -
and there are clearly more complex workarounds that I could devise,
but I'd prefer to keep the solution minimal and simple if I can. I'd
be very grateful for some guidance, even if it's to say: "Use a
workaround; FIND is bugged."

.

Relevant Pages