Avec une macro, bien sûr !
Voici une macro qui compte chaque mot utilisé au moins deux fois, et les affiche dans un nouveau document sous forme de tableau. Seuls les mots de plus de trois lettres sont comptés afin d'éviter les articles et autres petits mots.
Options :
1. Cette macro ne liste que les mots utilisés au moins deux fois. Vous pouvez modifier cette option :
- Si vous souhaitez tous les mots, même ceux utilisés une seule fois, supprimez les lignes situées entre 'option et 'fin option.
- Si vous souhaitez un autre minimum, remplacez le 1 par un autre nombre. Par exemple pour n'afficher que les mots utilisés au moins 5 fois, la ligne de code sera :
If dict(k) <= 4 Then dict.Remove k
2. Cette macro liste tous les mots du document. Si vous souhaitez ne lister que les mots qui commencent par une lettre, remplacez les lignes situées entre 'choix mots et 'fin choix mots par les suivantes, et mettez la lettre qui vous convient à la place de "a".
For Each wd In ActiveDocument.Words
tmp = Split(LCase(wd.Text), "'")
If wd.Characters(1) = "a" Then
For i = 0 To UBound(tmp)
' compte mots de plus de 3 lettres
If Len(tmp(i)) > 3 Then If dict.Exists(tmp(i)) Then dict(tmp(i)) = dict(tmp(i)) + 1 Else dict(tmp(i)) = 1
Next i
End If
Next wd
Remerciements à eriiic, à l'initiative de la macro
Sub compteMots()
'macro écrite par eriiic
Dim wd As Range, dict, k, result(), i As Long, tmp
Dim doc As Document, tabl As Table
Set dict = CreateObject("Scripting.Dictionary")
'choix mots
For Each wd In ActiveDocument.Words
tmp = Split(LCase(wd.Text), "'")
For i = 0 To UBound(tmp)
' compte mots de plus de 3 lettres
If Len(tmp(i)) > 3 Then If dict.Exists(tmp(i)) Then dict(tmp(i)) = dict(tmp(i)) + 1 Else dict(tmp(i)) = 1
Next i
Next wd
'fin choix mots
' Option
For Each k In dict.keys
If dict(k) <= 1 Then dict.Remove k 'suppression mots cités 1 seule fois
Next k
' fin option
If dict.Count > 0 Then
Set doc = Documents.Add
Set tabl = doc.Tables.Add(Range:=Selection.Range, NumRows:=dict.Count + 1, numcolumns:=2)
tabl.Cell(1, 1).Range.Text = "Mot": tabl.Cell(1, 2).Range.Text = "Cpt"
For Each k In dict.keys
i = i + 1
tabl.Cell(i, 1).Range.Text = k
tabl.Cell(i, 2).Range.Text = dict(k)
Next k
tabl.Sort True, 2, wdSortFieldNumeric, wdSortOrderDescending
tabl.Borders.Enable = True
End If
Set dict = Nothing
End Sub