XL 2016 Récupérerles mot dans une liste

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

carber

XLDnaute Nouveau
Bonsoir
Je cherche une personne qui peux m'aider à mettre en place un fichier Excel qui va m'aider énormément svp
Voilà j'ai une liste de mot, je souhaite extraire de cette liste tout les mots qui finissent par er, es, ont, ent, ées, ez
Un colonne ou je doit mettre ma liste de mot une feuille avec une colonne qui contient tout les 3 lettres
Et un feuille où je récupère le résultat
 
Bonjour Carber, R@chid,
En PJ un fichier que j'ai adapté provenant d'un jeu de lettres.
Le "dictionnaire" dispose de 26375 mots de 3 à 7 lettres.
On entre la terminaison désirée et on récupère la liste de mots.
Il suffit de l'adapter en fonction de ses besoins. la macro est simple :
VB:
Sub Filtre()
Dim Tableau, i%, IndexW%, T0
T0 = Timer
Sheets("Filtre").Range("A:A").ClearContents
FinMot = LCase(Sheets("Filtre").[G2]): NbLettres = Len(FinMot)
Tableau = Sheets("ListeMots").[ListeMots]
IndexW = 1
For i = 1 To UBound(Tableau)
    If LCase(Right(Tableau(i, 1), NbLettres)) = FinMot Then
        Sheets("Filtre").Cells(IndexW, "A") = Tableau(i, 1)
        IndexW = IndexW + 1
    End If
Next i
[G4] = IndexW & " mots trouvés"
[G5] = "( En " & Round(1000 * (Timer - T0), 0) & " ms. )"
End Sub
 

Pièces jointes

Dernière édition:
Le même avec plusieurs filtres en série, avec :
VB:
Sub Filtre()
Dim Tableau, i%, IndexW%, T0
Sheets("Filtre").Range("A:F").ClearContents
Tableau = Sheets("ListeMots").[ListeMots]
For N = 1 To 6
    IndexW = 1
    T0 = Timer
    FinMot = LCase(Sheets("Filtre").Cells(N + 1, "I")): NbLettres = Len(FinMot)
    For i = 1 To UBound(Tableau)
        If LCase(Right(Tableau(i, 1), NbLettres)) = FinMot Then
            Sheets("Filtre").Cells(IndexW, N) = Tableau(i, 1)
            IndexW = IndexW + 1
        End If
    Next i
    Cells(N + 1, "J") = IndexW & " mots trouvés"
    Cells(N + 1, "K") = "( En " & Round(1000 * (Timer - T0), 0) & " ms. )"
Next N
End Sub
 

Pièces jointes

Bonjour carber, R@chid, sylvanu, chris, patricktoulon,

Merci pour le fichier sylvanu.

Une macro très rapide dans le code de la feuille "Résultat" :
VB:
Private Sub Worksheet_Activate()
Dim mini%, d As Object, tablo, i&, x$, j%, maxi%, resu$(), n&
mini = 32767
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
With Sheets("Listes")
    tablo = .[C1].CurrentRegion.Resize(, 2) 'matrice, plus rapide, au moins 2 éléments
    For i = 2 To UBound(tablo)
        x = tablo(i, 1)
        d(x) = ""
        j = Len(x)
        If j > maxi Then maxi = j
        If j < mini Then mini = j
    Next i
    tablo = .[A1].CurrentRegion.Resize(, 2) 'matrice, plus rapide, au moins 2 éléments
    ReDim resu(1 To UBound(tablo), 1 To 1)
    For i = 2 To UBound(tablo)
        x = tablo(i, 1)
        For j = mini To maxi
            If d.exists(Right(x, j)) Then n = n + 1: resu(n, 1) = x
    Next j, i
End With
'---restitution---
If FilterMode Then ShowAllData
With [A2] '1ère cellule de destination, à adapter
    If n Then .Resize(n) = resu
    .Offset(n).Resize(Rows.Count - n - .Row + 1).ClearContents
End With
With UsedRange: End With 'actualise la barre de défilement verticale
End Sub
La macro se déclenche quand on active la feuille.

A+
 

Pièces jointes

Bonsoir je vous remercie pour vos réponses voici le fichier que j'ai un fichier test
la feuille 1 je mes mon texte
la feuille 2 c'est la liste des mots a exclure
la feuille 3 une macro qui récupère la liste de mot avec nombre cooccurrence.
voila le fichier avec la feuille 4 ou je dois ajouté critère de récupération des verbes
et feuille 5 ajouté une macro qui récupère tout les mots du texte de feuille 1 qui finnisent avec les critère de feuille 4

merci beaucoup
 

Pièces jointes

- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Retour