WORD'2007: word repetitions
Thread poster: DZiW

English to Russian
+ ...
Jul 1

Dear colleagues,

Now I'm struggling with a problem to mark all the repetitions within 50 words...
First I thought about CreateObject("Scripting.Dictionary"), but not sure how to handle it better.

The idea is simple: Prepare a 50-word FiFO (first-in, first-out) 'buffer' list as a string with space delimiters and check every next word, marking any repetitions and updating the list--deleting the first word and adding the new word--till the end.

I'm not a big coder, yet here is a quick'n'dirty draft
For i=1 to ThisDocument.Words.Count 'main loop
Set S=ThisDocument.Words(i) 'reference to the i-th word
W=Ucase(Trim(S)) 'no spaces and not case sensitive
If Left(W,1)=Letter Then 'IsAlpha only
If i>50 Then 'after the initial 50-word list is ready
q=InStr(1,W,T) 'is there a substring W in T?
if q>0 then S.Font.Color=some_color 'mark the repetition
q=InStr(1," ",T) 'find the first space delimiter
T=Mid(T,q+1) 'delete the first word plus space
End IF 'i>50
T=T+W+" " 'add new word to the list
End If 'Left(W,1)=Letter

However, something went wrong, in the very concept, perhaps)
How would you solve such a task? Also I'm not sure about CleanString, AscW and such for ANSI/Unicode, any ideas?


Direct link Reply with quote

English to Russian
+ ...
Slowpoking, but works Jul 2

Knowing several languages does interfere, even when it's just programming, especially when tired)
Sub Repetitions()
Const SPAN = 49 'range
N = ThisDocument.Words.Count: If N < 50 Then Exit Sub 'exit if nothing to do
Application.ScreenUpdating = 0 'to speed a little up
repetition = 0
Dim list As String
Dim word As String
list = ""
For i% = 1 To N 'loop with each word
Set s = ThisDocument.Words(i%) 'a reference to word
word = UCase(Trim(s)) 'clean word up

If Left(word, 1) Like "[A-ZА-Я]" Then 'if begins with a letter (=ignore numbers and garbage)

If i > SPAN Then 'if the list is ready
q = InStr(1, list, word + " ", 1): If q > 0 Then s.Font.ColorIndex = wdRed: repetition = repetition + 1 'found and marked
q = InStr(1, list, " ", 1): list = Mid(list, q + 1) 'remove the first (obsolete) word from list
End If 'i>49

list = list + word + " " 'add the new word to list
End If 'like

Application.StatusBar = N - i 'countdown
If i Mod 200 = 0 Then DoEvents 'check events, including CTRL+SCRLOCK
Application.ScreenUpdating = 1 'restore screen
Application.StatusBar = False 'reset status
'If repetition > 0 Then
MsgBox repetition, , "Repetitions"
End Sub

[Edited at 2017-07-02 20:14 GMT]

Direct link Reply with quote

To report site rules violations or get help, contact a site moderator:

You can also contact site staff by submitting a support request »

WORD'2007: word repetitions

Advanced search

SDL MultiTerm 2017
Guarantee a unified, consistent and high-quality translation with terminology software by the industry leaders.

SDL MultiTerm 2017 allows translators to create one central location to store and manage multilingual terminology, and with SDL MultiTerm Extract 2017 you can automatically create term lists from your existing documentation to save time.

More info »
You’re a freelance translator? LSP.expert helps you manage your daily translation jobs. It’s easy, fast and secure.

How about you start tracking translation jobs and sending invoices in minutes? You can also manage your clients and generate reports about your business activities. So you always keep a clear view on your planning, AND you get a free 30 day trial period!

More info »

  • All of ProZ.com
  • Term search
  • Jobs
  • Forums
  • Multiple search