Macro - un mot par ligne? Possible?

[magnusyou]

Hello à tous,

Je me permets de vous écrire car j'ai un besoin pour lequel je ne suis pas sûr qu'une macro puisse y répondre.. mais je tente!

En fait j'ai une liste de termes (phrase en fait) que je souhaiterais découper par mot.

Du coup, quand une cellule contient 4 mots, je souhaiterais obtenir sur les 4 lignes chaque mot séparé.

Le but de cela est de savoir quel sont les termes les plus utilisés dans cette liste de phrase.

Avez-vous une idée de comment construire une macro qui puisse répondre à cela?

Je vous mets un exemple en pj pour plus de précision.

Dans l'espoir de trouver une solution,

A bientôt

 

[Efgé]

Re : Macro - un mot par ligne? Possible?

Bonjour magnusyou

Une proposition, qui arrive directement au résultat, sans colonnes intermédiare ni TCD.
Le code est a lancer avec Alt+F8

Sub test()
Dim i&, J&
Dim D As Object, TData As Variant
Dim Tmp As Variant, TReport As Variant, K As Variant
Set D = CreateObject("scripting.dictionary")
With Sheets("Feuil1")
    TData = .Range("$B$3:$B" & .Cells(.Rows.Count, "B").End(3).Row)
End With
For i = LBound(TData, 1) To UBound(TData, 1)
    Tmp = Split(TData(i, 1), " ")
    For J = LBound(Tmp) To UBound(Tmp)
        D(Tmp(J)) = D(Tmp(J)) + 1
    Next J
Next i
i = 0
ReDim TReport(1 To D.Count, 1 To 2)
For Each K In D.Keys
    i = i + 1
    TReport(i, 1) = K
    TReport(i, 2) = D(K)
Next K
Sheets("Feuil1").Range("$G$2").Resize(D.Count, 2) = TReport
End Sub

 

[camarchepas]

Re : Macro - un mot par ligne? Possible?

Bonjour magnusyou , Efgé,

Voici une variante :

Sub Découpe()
Dim Mot As String
Dim FinB As Long, FinC As Long
Dim Tourne As Long, Espace As Long, Trouve As Long
Dim Phrase As String
FinB = Range("B" & Rows.Count).End(xlUp).Row
For Tourne = 3 To FinB
 Phrase = Range("b" & Tourne) & " "
 Espace = 0
 Trouve = 1
 Do
  Trouve = InStr(Trouve, Phrase, " ") + 1
  Mot = Split(Phrase, " ")(Espace)
  Range("C" & Range("C" & Rows.Count).End(xlUp).Row + 1) = Mot
  Espace = Espace + 1
 Loop Until InStr(Trouve, Phrase, " ") = 0
Next Tourne
End Sub

 

[magnusyou]

Re : Macro - un mot par ligne? Possible?

Hello à tous!!

Merci beaucoup pour vos réponses, les 2 cas fonctionnent

Petite préférence pour la première soluce qui me permet d'avoir le nombre d'occurrence trouvé dans la colonne à côté!

Je remarque aussi que la macro fait une différence entre les mêmes mots selon qu'il y ait présence d'une majuscule ou non.

Pour le mot "vente" et "Vente" l'outil me dit que c'est 2 mots différents. Comment faire pour enlever cette contrainte?

Merciiiiiiiii

 

[Efgé]

Re : Macro - un mot par ligne? Possible?

Bonjour magnusyou, Re camarchepas:
On peux choisir tout en minuscules :

D(LCase(Tmp(J))) = D(LCase(Tmp(J))) + 1

Cordialement

 

[magnusyou]

Re : Macro - un mot par ligne? Possible?

Bonjour Efgé,

Merci beaucoup pour ta réponse!

Stp, comment intégrer cette ligne à la macro de "camarchepas"?

Sub test()
Dim i&, J&
Dim D As Object, TData As Variant
Dim Tmp As Variant, TReport As Variant, K As Variant
Set D = CreateObject("scripting.dictionary")
With Sheets("Feuil1")
TData = .Range("$B$3:$B" & .Cells(.Rows.Count, "B").End(3).Row)
End With
For i = LBound(TData, 1) To UBound(TData, 1)
Tmp = Split(TData(i, 1), " ")
For J = LBound(Tmp) To UBound(Tmp)
D(Tmp(J)) = D(Tmp(J)) + 1
Next J
Next i
i = 0
ReDim TReport(1 To D.Count, 1 To 2)
For Each K In D.Keys
i = i + 1
TReport(i, 1) = K
TReport(i, 2) = D(K)
Next K
Sheets("Feuil1").Range("$G$2").Resize(D.Count, 2) = TReport
End Sub

?

Par avance merci de ton aide

magnusyou

 

[Efgé]

Re : Macro - un mot par ligne? Possible?

Bonjour magnusyou, Bonjour camarchepas
@ magnusyou
Le code que tu présente est le mien, pas celui de camarchepas...
Pour le mien tu remplace

D(Tmp(J)) = D(Tmp(J)) + 1

Par

D(LCase(Tmp(J))) = D(LCase(Tmp(J))) + 1

Pour celui de camarchepas, tu ne peux pas: Le code écrit, ligne par ligne chaque mot trouvé tel qu'il est trouvé.

Cordialement

 

[camarchepas]

Re : Macro - un mot par ligne? Possible?

Bonjour Magnusyou, Efgé,

Voici mon code modifé afin de remonter le nombre d'occurences ,et de ne pas tenir compte de la case des lettres.

Cordialement

Sub Découpe()
Dim Mot As String, Phrase As String
Dim FinB As Long, FinC As Long
Dim Tourne As Long, Espace As Long, Trouve As Long
Dim Cherche As Range
FinB = Range("B" & Rows.Count).End(xlUp).Row
For Tourne = 3 To FinB
 Phrase = Range("b" & Tourne) & " "
 Espace = 0
 Trouve = 1
 Do
  Trouve = InStr(Trouve, Phrase, " ") + 1
  Mot = LCase(Split(Phrase, " ")(Espace))
  Set Cherche = Range("C:C").Find(Mot, lookat:=xlWhole)
  If Cherche Is Nothing Then
    Range("C" & Range("C" & Rows.Count).End(xlUp).Row + 1) = LCase(Mot)
    Range("D" & Range("C" & Rows.Count).End(xlUp).Row) = 1
   Else
    Range("C" & Cherche.Row) = LCase(Mot)
    Range("D" & Cherche.Row) = Range("D" & Cherche.Row) + 1
  End If
  Espace = Espace + 1
 Loop Until InStr(Trouve, Phrase, " ") = 0
Next Tourne
End Sub