Macro chercher, deplacer et compter

Bonjour à tous,

Je cherche à faire une macro qui me parait un peu compliqué pour quelqu'un qui n'a jamais touché du doigt ce domaine. J'essaie de le faire par moi même avec les différents forums mais je commence à bloquer.

J'ai une chaine de texte avec des caractères spéciaux comme l'apostrophe ou les crochets. Ce que je souhaite c'est de pouvoir isoler chaque mot et de pouvoir compter le nombre de fois ou ceux ci apparaissent.

A savoir que le nombre de mot est variable. Il peut y en avoir 0 comme 10. Et je ne souhaite pas suprimer la colonne original

Je joins un exemple fait a la main

Je sais que cela fait beaucoup de chose désolé

Merci de votre aide.

Salut Hardewin et

Voici le code qui inscrira les mot et le nombre à partir de la colonne K

J'ai essayé de l'expliciter au maximum

Sub CompteMots()
  Dim DLig As Long, Lig As Long
  Dim MonDico As Object, Mot As Variant, TabMot() As String, TxtMeF As String
  Dim Ind As Integer
  ' Créer un dictionnaires des mots
  Set MonDico = CreateObject("Scripting.Dictionary")
  ' Trouver la dernière ligne de la colonne G
  DLig = Range("G" & Rows.Count).End(xlUp).Row
  ' Pour chaque ligne
  For Lig = 1 To DLig
    If Range("G" & Lig).Value = "" Then GoTo SuiteLig
    ' Sinon mettre en forme le texte pour commencer
    TxtMeF = Range("G" & Lig).Value
    ' Supprimer les crochets
    TxtMeF = Replace(Replace(TxtMeF, "[", ""), "]", "")
    ' Supprimer les appostrophes
    TxtMeF = Replace(TxtMeF, "'", "")
    ' Supprimer les espaces après la virgule
    TxtMeF = Replace(TxtMeF, ", ", ",")
    ' Créer un tableau des mots
    TabMot = Split(TxtMeF, ",")
    ' Pour chaque mot
    For Each Mot In TabMot
      ' Créer le dictionnaire avec le nombre
      MonDico(Mot) = MonDico(Mot) + 1
    Next
    ' Inscrire les valeurs
    For Ind = 0 To MonDico.Count - 1
      Cells(Lig, Range("K1").Column + (Ind * 2)).Value = MonDico.keys()(Ind)
      Cells(Lig, Range("L1").Column + (Ind * 2)).Value = MonDico.items()(Ind)
    Next Ind
    ' Effacer le contenu
    MonDico.RemoveAll

SuiteLig:
  Next Lig
End Sub

A+