Création de Liste de mot

Bonjour,

Je cherche à réaliser une automatisation via Excel, mais je ne vois pas comment m'y prendre.
J'ai deux plage :
- La première, SousType, situé dans la feuille squelette, contient des chaines de caractères.
- La seconde, ListeType, situé dans la feuille Type, est vide.
- Je voudrais faire en sorte que tout les mots contenu dans une Cellule de SousType soit lister dans ListeType automatiquement, en les Triant, en n'affichant que 1 seul fois chaque mot pour éviter les doublons, et en retirant le mot de liaison 'et' qui peut être contenu dans SousType.
Ainsi, si ma plage SousType contient 'Lapin et Pirate', 'Humain et Pirate' et 'Pirate', ListeType devrais contenir Humain, Lapin, Pirate.

Si vous avez une idée de comment le réalisé, je vous remercie d'avance.
Patmol25

bonsoir patmol25,

comme ceci ?

Sub Mots()
     Dim Dict, aA, i
     Set Dict = CreateObject("scripting.dictionary")
     Dict.comparemode = vbTextCompare

     aA = Sheets("squelette").UsedRange.Columns("E").Value     'toute cette colonne
     For i = 2 To UBound(aA)
          If Len(aA(i, 1)) Then
               sp = Split(aA(i, 1), " et ", , 1)     'séparer sur le " et "
               For j = 0 To UBound(sp)
                    Dict(sp(j)) = sp(j)
               Next
          End If
     Next

     ptr = Dict.Count
     If Dict.Count = 1 Then Dict([Rnd]) = vbEmpty     'problème avec dictionaire avec 1 élément

     With Sheets("type").Columns("H")
          .ClearContents
          If ptr > 0 Then
               With .Resize(ptr)
                    .Value = Application.Transpose(Dict.keys)
                    .Sort .Range("A1"), Header:=xlNo
               End With
          End If
     End With

End Sub

Bonsoir Bart,

Je l'ai attribué à un bouton et celà fonctionne comme je le cherchais, merci beaucoup.
Sais tu néanmoins si il est possible que la liste s'update d'elle même, sans avoir besoin d'executer la macro à chaque fois ?

Patmol25

bonjour patmol25,

quand vous ajoutez ceci dans le module de la feuille "squelette"

Private Sub Worksheet_Change(ByVal Target As Range)
     If Not Intersect(Target, Me.Columns("E")) Is Nothing Then Mots
End Sub

Bonjour,

Je ne suis pas sur de comprendre, il me suffit de le mettre ainsi ?

Si c'est le cas, cela ne fonctionne pas.
Patmol25

bonjour patmol25,

non, il faut coller cela dans le module de la feuille "squelette" et ne pas dans le "module2"

Bonjour,

Cela fonctionne exactement comme je le souhaitais, merci beaucoup

Patmol25