user_mobilelogo

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.

Cette macro fonctionne à partir de la sélection. Donc, sélectionnez votre texte avant d'exécuter la macro. Si vous souhaitez l'appliquer sur un document entier, sélectionnez tout (Ctrl+A).

Option :

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

Remerciements à eriiic, auteur 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")
    For Each wd In Selection.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

    ' 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'hui176
Hier1535
Cette semaine17500
Ce mois19106
Total depuis 200411595225

3
visiteurs actuellement en ligne

8 décembre 2019