Extraire des mots selon une chaine de caractères

Bonjour.

Je suis en train de créer un petit jeu sur excel qui ressemble au Scrabble.

En quelques mots: on reçoit aléatoirement 8 lettres de l'alphabet (les doubles sont autorisés) et on a tant de temps pour former le mot le plus long avec ces lettres.

Je tente maintenant d'avoir une sorte d'aide qui afficherait la liste de tous les mots qui auraient possibles avec ces lettres.

Pour cela j'ai créer une liste d'environ 45'000 mots du dictionnaire allant de 2 à 8 lettres et dans l'ordre alphabétique.

Ces mots se trouvent dans la colonne B de ma feuille1.

Dans une autre cellule (N1 par exemple) j'ai concaténer les 8 lettres reçues.

J'ai ensuite créé un petit tableau de 7 colonnes pour les mots classés par nombre de lettre par mots (2lettres, 3 lettres, 4 lettres, etc)

Je cherche une macro me permettant parcourir tous les mots en colonne B, de les extraire si les lettres données permettent de les écrire et de les écrire dans la bonne colonne de mon tableau.

En gros: si je reçoit "AGOPZTAR", quels sont les mots de ma liste que je peux former avec ces lettres.

J'ai déjà fait quelques tentatives mais cela me demande un nombre incalculable de formules excel (un peu bricolée) et le programme prend énormément de temps pour me sortir la liste des mots possibles.

Si quelqu'un a une petite idée...

Merci beaucoup

MVBAM

Bonjour

Avec 8 lettres, on peut par permutation obtenir un tableau de 8 colonnes représentant les 40320 combinaisons possibles, avec une fonction personnalisée initiée par Thierry Pourtier.

A titre indicatif, ce nombre de permutations possibles est donné par la formule

=PERMUTATION(8;8)

Pour obtenir les mots de deux lettres, on utilise les 2 premières colonnes, pour les mots de 3 lettres, les 3 premières, etc.

Rien qu'avec ce tableau, les résultats étant donnés par formules matricielles, on a déjà un fichier de 11 Mo.

Ces résultats étant numériques, il va falloir utiliser 40320x8 fonctions de recherches supplémentaires pour transformer le tableau numérique en lettres, puis concaténer chaque ligne pour obtenir 8 lettres sur chaque ligne et un nombre incalculable de fonctions de recherche pour trouver les combinaisons correspondants aux mots de ta base de 45000 mots.

Autant dire, un travail titanesque (selon moi)

Le fichier de Ti joint.

En suivant les instructions, tu peux essayer....

Cordialement

Bonjour,

bette prise de tête si c'est pour le plaisir de la masturbation intellectuelle, ça va fonctionner mais perso, j'en suis incapable, je préfère utiliser (si je l'ai toujours)...le programme qui sert d'arbitre en compétition

P.

Bonsoir le fil, bonsoir le forum,

Bon !... Alors, passer derrière le Ti c'est grillé d'avance... Mais comme le ridicule ne tue pas, voici ma proposition.

Je l'ai testée sur une dizaine de mots à peine et elle semble tourner. Mais avec plus de 45.000 mots voilà la procédure :

1 - Tu lances la macro

2 - Tu pars en vacances (ho pas longtemps ! Quelques mois suffisent)

3 - Tu reviens

4 - Tu attends quelques heures

5 - Au choix :

Tu éteints ton ordinateur qui prend feu à cause de la surchauffe du processeur...

Tu vois s'afficher le résultat !

J'ai considéré, comme tu le précisais dans l'exposé du problème, que la concaténation du tirage était en N1 les mots possibles sont renvoyés à partir de D1 (2 lettres) jusqu'à J1 (8 lettres). Le tableau est effacée à chaque lancement de la macro...

Le code :

Sub Macro1()
Dim O As Worksheet 'déclare la variable O (Onglet)
Dim DL As Long 'déclare la variable DL (Dernière Ligne)
Dim X As Long 'déclare la variable X (incrément)
Dim CC As Integer 'déclare la variable CC (Comparateur de Caractères)
Dim I As Long 'déclare la variable I (Incrément)
Dim NC As Integer 'déclare la variable NC (Nombre de Caractères)
Dim TM() As Variant 'déclare la variable TM (Tableau des Mots)
Dim C As Integer 'déclare la variable C (Caractère)
Dim LM As Integer 'déclare la variable LM (Lettre du Mot)
Dim LT As Integer 'déclare la variable LT (Lettre du Tirage)

Application.ScreenUpdating = False 'masque les raffraîchissements d'écran
Set O = Worksheets("Feuil1") 'définit l'onglet O (à adapter à ton cas)
O.Range("D1:K" & Application.Rows.Count).ClearContents 'efface d'éventuelles anciennes données
DL = Cells(Application.Rows.Count, 2).End(xlUp).Row 'définit la dernièr eligne éditée DL de la colonne 2 (=B) de l'onglet O
X = 1 'initialise la variable X
CC = 2 'initialise la variable CC
For I = 1 To DL 'boucle 1 : sur les lignes de 1 à DL (=tous les mots de la colonne B)
    NC = Len(O.Cells(I, 2).Value) 'définit le nombre de caractères NC de la cellule ligne I colonne 2 (=mot de la boucle 1)
    If NC <> CC Then 'condition : si le nombre de caractères du mots NC est différent du comparateur de caractères CC
        'si X est supérieure à un, renvoie dans la cellule ligne 1, colonne CC+2 de l'onglet O, le tableau TM transposé
        If X > 1 Then O.Cells(1, CC + 2).Resize(UBound(TM), 1).Value = Application.Transpose(TM)
        CC = CC + 1 'redéfinit le comparateur de caractères CC
        X = 1 'réinitialise la variable X
        Erase TM 'efface le tableau TM
    End If 'fin de la condition
    For C = 1 To 8 'boucle 2 : sur les 8 caractères du tirage
        'renvoie dans la cellule ligne 2, colonne 13+C de l'onglet O, le caractère C de la boucle
        O.Cells(2, 13 + C).Value = Mid(O.Range("N1").Value, C, 1)
    Next C 'prochain caractère de la boucle
    For LM = 1 To NC 'boucle 3 : sur toutes les lettres du mot de la boucle 1
        For LT = 1 To 8 'boucle 4 : sur les 8 lettres du tirage
            'condition : si la lettre du mot de la boucle 3 correspond à la lettre de la cellule ligne 2, colonne LT+13
            If Mid(O.Cells(I, 2), LM, 1) = O.Cells(2, LT + 13) And O.Cells(2, LT + 13).Value <> "" Then
                O.Cells(2, LT + 13).Value = "" 'efface la cellule ligne 2, colonne LT+13
                Exit For 'sort de la boucle 4
            End If 'fin de la condition
        Next LT 'prochaine lettre du tirage de la boucle 4
    Next LM 'prochaine lettre du mot de la boucle 3
    'condition : si le nombre de cellule vide de la plage N2:U2 est égal au nombre de caractères du mot de la boucle 1
    'cela signifie que toutes les lettres du mots font partie des lettres du tirage
    If Application.WorksheetFunction.CountBlank(O.Range("N2:U2")) = NC Then
        ReDim Preserve TM(1 To X) 'redimensionne le tableau des mots TM
        TM(X) = O.Cells(I, 2).Value 'ajoute le mot de la boucle 1 au tableau des mots TM
        X = X + 1 'incrément X
    End If 'fin de la condition
Next I 'prochain mot de la boucle
'à la fin, pour ajouter les mots de 8 lettres (si il y en a)
'si X est supérieure à un, renvoie dans la cellule ligne 1, colonne CC+2, le tableau TM transposé
If X > 1 Then O.Cells(1, CC + 2).Resize(UBound(TM), 1).Value = Application.Transpose(TM)
O.Range("N2:U2").ClearContents 'efface la plage N2:U2
Application.ScreenUpdating = True 'affiche les raffraîchissements d'écran
End Sub

Merci beaucoup pour ces réponses !

Je vais voir pour comprendre tout ça et essayer de le mettre en pratique.

Je vous tiendrais au courant du résultat (si l'ordinateur n'a pas pris feu...)

MVBAM

Bonjour

Si j ai bien compris :

Un mot est valide s'il figure dans la colonne B, Le joueur doit chercher à faire des mots qui se composent par deux lettres ou plus, bien sur La recherche des mots les plus longs doit être prioritaire (8 lettres est le plus long). Tous les mots sont généralement permis (il ne traite pas les mots composés avec apostrophe ou trait d'union mais vous aurez une option pour les accents)

Merci à tous de vous être penché sur le problème...

Tout fonctionne à merveille ! C'est génial !

MVBAM