Mrrrr's Forum (VIEW ONLY)
Un forum care ofera solutii pentru unele probleme legate in general de PC. Pe langa solutii, aici puteti gasi si alte lucruri interesante // A forum that offers solutions to some PC related issues. Besides these, here you can find more interesting stuff.
|
Lista Forumurilor Pe Tematici
|
Mrrrr's Forum (VIEW ONLY) | Reguli | Inregistrare | Login
POZE MRRRR'S FORUM (VIEW ONLY)
Nu sunteti logat.
|
Nou pe simpatie:
AlinaMicu pe Simpatie.ro
 | Femeie
25 ani
Brasov
cauta Barbat
25 - 39 ani |
|
Mrrrr
AdMiN
 Inregistrat: acum 17 ani
Postari: 2186
|
|
Source:
Without VBA ----- using Find & Replace:
1. Press CTRL+H to display find and replace
2. In Find field write the desired word / phrase
3. In Replace field write ^&
Note: this replaces the word you find with itself
4. Press Replace All button
The total number of replacements is the number of occurrences
With VBA:
Sub FindWords()
Dim sResponse As String
Dim iCount As Integer
' Input different words until the user clicks cancel
Do
' Identify the word to count
sResponse = InputBox( _
Prompt:="What word do you want to count?", _
Title:="Count Words", Default:="")
If sResponse > "" Then
' Set the counter to zero for each loop
iCount = 0
Application.ScreenUpdating = False
With Selection
.HomeKey Unit:=wdStory
With .Find
.ClearFormatting
.Text = sResponse
' Loop until Word can no longer
' find the search string and
' count each instance
Do While .Execute
iCount = iCount + 1
Selection.MoveRight
Loop
End With
' show the number of occurences
MsgBox sResponse & " appears " & iCount & " times"
End With
Application.ScreenUpdating = True
End If
Loop While sResponse <> ""
End Sub |
In the source link above there is also a code to find all unique values inside a document. I also put the code below in next post
_______________________________________
|
|
| pus acum 5 ani |
|
Mrrrr
AdMiN
Inregistrat: acum 17 ani
Postari: 2186
|
|
Sub WordFrequency()
Const maxwords = 9000 'Maximum unique words allowed
Dim SingleWord As String 'Raw word pulled from doc
Dim Words(maxwords) As String 'Array to hold unique words
Dim Freq(maxwords) As Integer 'Frequency counter for unique words
Dim WordNum As Integer 'Number of unique words
Dim ByFreq As Boolean 'Flag for sorting order
Dim ttlwds As Long 'Total words in the document
Dim Excludes As String 'Words to be excluded
Dim Found As Boolean 'Temporary flag
Dim j, k, l, Temp As Integer 'Temporary variables
Dim ans As String 'How user wants to sort results
Dim tword As String '
' Set up excluded words
Excludes = "[the][a][of][is][to][for][by][be][and][are]"
' Find out how to sort
ByFreq = True
ans = InputBox("Sort by WORD or by FREQ?", "Sort order", "WORD")
If ans = "" Then End
If UCase(ans) = "WORD" Then
ByFreq = False
End If
Selection.HomeKey Unit:=wdStory
System.Cursor = wdCursorWait
WordNum = 0
ttlwds = ActiveDocument.Words.Count
' Control the repeat
For Each aword In ActiveDocument.Words
SingleWord = Trim(LCase(aword))
'Out of range?
If SingleWord < "a" Or SingleWord > "z" Then
SingleWord = ""
End If
'On exclude list?
If InStr(Excludes, "[" & SingleWord & "]") Then
SingleWord = ""
End If
If Len(SingleWord) > 0 Then
Found = False
For j = 1 To WordNum
If Words(j) = SingleWord Then
Freq(j) = Freq(j) + 1
Found = True
Exit For
End If
Next j
If Not Found Then
WordNum = WordNum + 1
Words(WordNum) = SingleWord
Freq(WordNum) = 1
End If
If WordNum > maxwords - 1 Then
j = MsgBox("Too many words.", vbOKOnly)
Exit For
End If
End If
ttlwds = ttlwds - 1
StatusBar = "Remaining: " & ttlwds & ", Unique: " & WordNum
Next aword
' Now sort it into word order
For j = 1 To WordNum - 1
k = j
For l = j + 1 To WordNum
If (Not ByFreq And Words(l) < Words(k)) _
Or (ByFreq And Freq(l) > Freq(k)) Then k = l
Next l
If k <> j Then
tword = Words(j)
Words(j) = Words(k)
Words(k) = tword
Temp = Freq(j)
Freq(j) = Freq(k)
Freq(k) = Temp
End If
StatusBar = "Sorting: " & WordNum - j
Next j
' Now write out the results
tmpName = ActiveDocument.AttachedTemplate.FullName
Documents.Add Template:=tmpName, NewTemplate:=False
Selection.ParagraphFormat.TabStops.ClearAll
With Selection
For j = 1 To WordNum
.TypeText Text:=Trim(Str(Freq(j))) _
& vbTab & Words(j) & vbCrLf
Next j
End With
System.Cursor = wdCursorNormal
j = MsgBox("There were " & Trim(Str(WordNum)) & _
" different words ", vbOKOnly, "Finished")
End Sub |
_______________________________________
|
|
| pus acum 5 ani |
|