Advertisement
Guest User

Untitled

a guest
Apr 8th, 2019
114
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. ' Control the repeat
  2.    For Each aword In ActiveDocument.Words
  3.         SingleWord = Trim(LCase(aword))
  4.         'Out of range?
  5.        If SingleWord < "a" Or SingleWord > "z" Then
  6.             SingleWord = ""
  7.         End If
  8.         'On exclude list?
  9.        If InStr(Excludes, "[" & SingleWord & "]") Then
  10.             SingleWord = ""
  11.         End If
  12.         If Len(SingleWord) > 0 Then
  13.             Found = False
  14.             For j = 1 To WordNum
  15.                 If Words(j) = SingleWord Then
  16.                     Freq(j) = Freq(j) + 1
  17.                     Found = True
  18.                     Exit For
  19.                 End If
  20.             Next j
  21.             If Not Found Then
  22.                 WordNum = WordNum + 1
  23.                 Words(WordNum) = SingleWord
  24.                 Freq(WordNum) = 1
  25.             End If
  26.             If WordNum > maxwords - 1 Then
  27.                 j = MsgBox("Too many words.", vbOKOnly)
  28.                 Exit For
  29.             End If
  30.         End If
  31.         ttlwds = ttlwds - 1
  32.         StatusBar = "Remaining: " & ttlwds & ", Unique: " & WordNum
  33.     Next aword
  34.  
  35.     ' Now sort it into word order
  36.    For j = 1 To WordNum - 1
  37.         k = j
  38.         For l = j + 1 To WordNum
  39.             If (Not ByFreq And Words(l) < Words(k)) _
  40.               Or (ByFreq And Freq(l) > Freq(k)) Then k = l
  41.         Next l
  42.         If k <> j Then
  43.             tword = Words(j)
  44.             Words(j) = Words(k)
  45.             Words(k) = tword
  46.             Temp = Freq(j)
  47.             Freq(j) = Freq(k)
  48.             Freq(k) = Temp
  49.         End If
  50.         StatusBar = "Sorting: " & WordNum - j
  51.     Next j
  52.  
  53.     ' Now write out the results
  54.    tmpName = ActiveDocument.AttachedTemplate.FullName
  55.     Documents.Add Template:=tmpName, NewTemplate:=False
  56.     Selection.ParagraphFormat.TabStops.ClearAll
  57.     With Selection
  58.         For j = 1 To WordNum
  59.             .TypeText Text:=Trim(Str(Freq(j))) _
  60.               & vbTab & Words(j) & vbCrLf
  61.         Next j
  62.     End With
  63.     System.Cursor = wdCursorNormal
  64.     j = MsgBox("There were " & Trim(Str(WordNum)) & _
  65.       " different words ", vbOKOnly, "Finished")
  66. End Sub
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement