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(11).Range.Text = "Mot":  tabl.Cell(12).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 True2, wdSortFieldNumeric, wdSortOrderDescending
        tabl.Borders.Enable = True
    End If
    Set dict = Nothing
End Sub