Générer une liste de mots avec leur occurrence (plusieurs cellules)

Bonjour Nehelya,

Pourrais-tu joindre un fichier anonymisé svp ainsi que la liste des mots à exclure !

Ci-dessus la trame que j'aimerais pour mon fichier. En sachant qu'il faudrait prendre toute la plage de donnée : A2:U84

Je ne peux malheureusement vous fournir le fichier original car les données sont des données sensibles.

La liste d'exclusion est dans l'onglet 2

Et j'aimerais générer la liste des récurrences mots dans l'onglet 3.

Peut-être utiliser une étape intermédiaire pour "spliter" les phrases en plusieurs mots avant le comptage ?

Merci pour votre aide

Bonsoir Nehelya,

Désolé pour le temps, ta demande requiert des connaissances que je n'avais pas, ce qui m'a demandé un peu de temps mais a été un très bon exercice pour moi !
Voici ton fichier

Est-ce cela que tu attendais ?
Je pense que je peux améliorer un peu la vitesse d'exécution de la macro.

J'ai laissé les chiffres, c'est bon ?
J'ai enlevé dans ta liste de mots à enlever, les caractères spéciaux. Je les traite (=enlève) tous automatiquement.

Également, dans le texte que tu avais mis dans chaque cellule, il y avait des paragraphes. Je les ai enlevé, mais si dans ton fichier originale il y en a, avec ma macro il y aura peut-être des coquilles...

Dis moi tes retours

Bonne soirée,

Baboutz

EDIT : On pourrait même trier la liste directement pour avoir en premier le mot qui ressort le plus !

Bonjour Baboutz!

Merci pour ce super travail !

Si j'ai bien compris le fonctionnement de la macro je peux alimenter ma liste d'exclusion donc ne t'en fait pas pour les chiffres je le ferais :)

Pour l'ordre du plus petit au plus grand je vais faire un filtre et ca devrais être niquel!

Mon fichier original étant plus complexe (beaucoup trop de colonnes et lignes) je pense utiliser ton fichier comme moyen d'extraction, et ca, ca va vraiment m'aider dans mon travail !

Je suis impressionnée par ta rapidité ! et te remercie énormément !

A bientôt !

Nehelya

Salut Nehelya,

Il n'y a pas de soucis !

Je t'ai fait une version deux sans les chiffres, il vaut mieux ne pas les ajouter à la liste de mots à exclure, cela fera moins mouliner la macro.
Je t'ai également ajouté le filtre automatique, ça ne prend pas de temps dans la macro !

Option Explicit

Sub ListeMots()

    'On désactive les messages d'alertes d'excel et on désactive le défilement des macros
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    'Déclaration des variables
    Dim DernLigne As Integer, DernCol As Integer, i As Integer
    Dim reg As VBScript_RegExp_55.RegExp
    Dim MonDico As Scripting.Dictionary
    Dim texte As String, tbl() As String
    Dim c As Range, cell As Range

    'Déclaration variables objets
    Set reg = New VBScript_RegExp_55.RegExp
    Set MonDico = CreateObject("Scripting.Dictionary")

    'Regex multiligne et globale activées
    reg.MultiLine = True
    reg.Global = True

    'Calcul de la dernière ligne et de la dernière colonne
    DernLigne = Worksheets("Données brutes").Cells(2, 1).End(xlDown).Row
    DernCol = Worksheets("Données brutes").Cells(2, 1).End(xlToRight).Column

    'Suppression du tableau
    On Error Resume Next 'Gère si tableau déjà vide
    Worksheets("Récurrence mots").Range("Tableau_Extraction").Delete Shift:=xlUp
    Worksheets("Récurrence mots").ListObjects("Tableau_Extraction").Sort.SortFields.Clear

    'Pour chaque cellule ayant des données brutes
    For Each cell In Worksheets("Données brutes").Range(Worksheets("Données brutes").Cells(2, 1), Worksheets("Données brutes").Cells(DernLigne, DernCol))

        texte = cell

        reg.Pattern = "'"
        texte = reg.Replace(texte, " ") 'Remplace apostrophe (') par espace

        reg.Pattern = "[^A-zÀ-ÖÙ-öù-ÿŒœ ]"
        texte = reg.Replace(texte, "") 'Supprime tout ce qui n'est pas une lettre, un chiffre ou un espace

        reg.Pattern = "  | [A-zÀ-ÖÙ-öù-ÿŒœ] "
        texte = reg.Replace(texte, " ") 'Remplace les doubles espaces ou lettre seule par espace

        tbl = Split(LCase(texte), " ") 'Met la chaîne de caractère en minuscule et la split dans tbl

        'ajout dans dico + comptage doublon
        For i = 0 To UBound(tbl) - 1
          MonDico(tbl(i)) = MonDico(tbl(i)) + 1
        Next i

    Next cell

    'Retire les mots à exclure si présent
    For Each c In Worksheets("Liste mots à exclure").Range("a4", Worksheets("Liste mots à exclure").[a65000].End(xlUp))
        On Error Resume Next
        MonDico.Remove (c.Value)
    Next c

    'Place les données dans la feuille voulue
    Worksheets("Récurrence mots").[a2].Resize(MonDico.Count, 1) = Application.Transpose(MonDico.keys)
    Worksheets("Récurrence mots").[b2].Resize(MonDico.Count, 1) = Application.Transpose(MonDico.items)

    'Trie des valeurs
    Worksheets("Récurrence mots").ListObjects("Tableau_Extraction"). _
        Sort.SortFields.Add2 Key:=Range("Tableau_Extraction[[#All],[Ordre]]"), _
        SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    With Worksheets("Récurrence mots").ListObjects("Tableau_Extraction").Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

End Sub

Vraiment content d'avoir pu t'aider ! Si tu remarques des anomalies et/ou coquilles, n'hésite pas à revenir.

Bonne journée,

Baboutz

EDIT : J'ai oublié de préciser un point important : les références Microsoft Scripting Runtime et Microsoft VBScript Regular Expressions 5.5 doivent être activées !

Oooh, Génial, c'est super gentil.

Je vais travailler sur mon fichier aujourd'hui, et rajouter d'autres éléments d'analyse. Je te ferais un retour si je remarque des coquilles.

Encore milles mercis. (Impossible de trouver une solution sur internet! et quand on est pas spécialiste c'est pas tout le temps évident ;) )

J'espère que ce post aidera d'autres personnes!

Ça marche, avec plaisir !

Pas de soucis, le forum est fait pour ça, si tu as cherché sur internet avant c'est top !
J'espère aussi que ça pourra servir à d'autres personnes

Et recoucou, c'est de nouveau moi...

Encore une fois merci pour ton travail, j'ai un peu avancé sur le document et j'ai remarqué que le fichier ne permet pas d'inclure tout les mots.

Je m'explique : Certaines de mes cellules contiennent du texte "maison bleue", d'autres un mot unique "maison" (sans espace ni rien). La macro ne permet pas de comptabilisé ces derniers.

Y a t'il un moyen pour les inclure dans la macro ?

Merci d'avance !!

Salut Nehelya,

En effet, petite grosse erreur de ma part... C'est corrigé :

Option Explicit

Sub ListeMots()

    'On désactive les messages d'alertes d'excel et on désactive le défilement des macros
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    'Déclaration des variables
    Dim DernLigne As Integer, DernCol As Integer, i As Integer
    Dim reg As VBScript_RegExp_55.RegExp
    Dim MonDico As Scripting.Dictionary
    Dim texte As String, tbl() As String
    Dim c As Range, cell As Range

    'Déclaration variables objets
    Set reg = New VBScript_RegExp_55.RegExp
    Set MonDico = CreateObject("Scripting.Dictionary")

    'Regex multiligne et globale activées
    reg.MultiLine = True
    reg.Global = True

    'Calcul de la dernière ligne et de la dernière colonne
    DernLigne = Worksheets("Données brutes").Cells(2, 1).End(xlDown).Row
    DernCol = Worksheets("Données brutes").Cells(2, 1).End(xlToRight).Column

    'Suppression du tableau
    On Error Resume Next 'Gère si tableau déjà vide
    Worksheets("Récurrence mots").Range("Tableau_Extraction").Delete Shift:=xlUp
    Worksheets("Récurrence mots").ListObjects("Tableau_Extraction").Sort.SortFields.Clear

    'Pour chaque cellule ayant des données brutes
    For Each cell In Worksheets("Données brutes").Range(Worksheets("Données brutes").Cells(2, 1), Worksheets("Données brutes").Cells(DernLigne, DernCol))

        texte = cell.Value

        reg.Pattern = "'"
        texte = reg.Replace(texte, " ") 'Remplace apostrophe (') par espace

        reg.Pattern = "[^A-zÀ-ÖÙ-öù-ÿŒœ ]"
        texte = reg.Replace(texte, "") 'Supprime tout ce qui n'est pas une lettre, un chiffre ou un espace

        reg.Pattern = "  | [A-zÀ-ÖÙ-öù-ÿŒœ] "
        texte = reg.Replace(texte, " ") 'Remplace les doubles espaces ou lettre seule par espace

        If texte Like "*[ ]*" Then
            tbl = Split(Trim(LCase(texte)), " ") 'Met la chaîne de caractère en minuscule et la split dans tbl

            'ajout dans dico + comptage doublon
            For i = 0 To UBound(tbl)
              MonDico(tbl(i)) = MonDico(tbl(i)) + 1
            Next i
        Else
            MonDico(Trim(LCase(texte))) = MonDico(Trim(LCase(texte))) + 1
        End If

    Next cell

    'Retire les mots à exclure si présent
    For Each c In Worksheets("Liste mots à exclure").Range("a4", Worksheets("Liste mots à exclure").[a65000].End(xlUp))
        On Error Resume Next
        MonDico.Remove (c.Value)
    Next c

    'Place les données dans la feuille voulue
    Worksheets("Récurrence mots").[a2].Resize(MonDico.Count, 1) = Application.Transpose(MonDico.keys)
    Worksheets("Récurrence mots").[b2].Resize(MonDico.Count, 1) = Application.Transpose(MonDico.items)

    'Trie des valeurs
    Worksheets("Récurrence mots").ListObjects("Tableau_Extraction"). _
        Sort.SortFields.Add2 Key:=Range("Tableau_Extraction[[#All],[Ordre]]"), _
        SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    With Worksheets("Récurrence mots").ListObjects("Tableau_Extraction").Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

End Sub

Génial, encore une fois merci !