user_mobilelogo

Word 365: Vous saurez tout !

Pour tout connaître sur Word
Nouvelle version !

600 pages !

9,80 € 

 

En savoir plus.

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

 

 

 

Statistiques

Aujourd'hui302
Hier2908
Cette semaine16627
Ce mois79424
Total depuis 200412598056

17
visiteurs actuellement en ligne

28 novembre 2020