XL 2016 Récupérerles mot dans une liste

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
 

sylvanu

XLDnaute Barbatruc
Supporter XLD
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

  • Fin de mots.xlsm
    429.4 KB · Affichages: 12
Dernière édition:

sylvanu

XLDnaute Barbatruc
Supporter XLD
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

  • Fin de mots 2.xlsm
    494.6 KB · Affichages: 6

job75

XLDnaute Barbatruc
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

  • Fin de mots(1).xlsm
    352.2 KB · Affichages: 7

carber

XLDnaute Nouveau
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

  • test-v3.xlsm
    44.1 KB · Affichages: 7

Discussions similaires

Réponses
21
Affichages
1 K

Statistiques des forums

Discussions
292 942
Messages
1 927 370
Membres
183 525
dernier inscrit
testapp