VBA Excel - Récursivité - Jeu du Boggle

Messages postés
12253
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
19 juillet 2019
-
Bonjour Mesdames, Messieurs,

Il y a deux ans, j'ai voulu créer une fiche pratique, sur CCM, intitulée "le jeu du boggle". visible ICI. Comme vous pourrez le voir en y jetant un oeil, c'est pas mal, mais pas top...

A l'époque, je ne connaissais pas la récursivité et j'avais toutefois réussi à "bricoler" un code qui à défaut d'être parfait, fonctionnait à peu près.

Fini l'à peu près pour moi, je souhaites refonder ce code afin de le rendre réellement opérationnel.

Pour cela, je vais avoir besoin de vous...

Il faut, pour cette "appli", plusieurs codes. Je vais créer, dans ce sujet, une réponse par code. Suffira de suivre en commentant ces réponses pour améliorer les codes VBA proposés.

Les différents codes nécessaires :
- récupérer un dictionnaire extrait d'un fichier .txt dans une variable sous VBA (soit une variable tableau, soit un objet dictionary)
- tirage aléatoire des lettres,
- comparaison des lettres du tirage avec l'alphabet afin de voir qu'elles lettres sont manquantes,
- grâce aux lettres manquantes, épurer la liste des mots du dico,
- trouver peut être une seconde méthode d'épuration de cette liste...
- créer un code qui va trouver les mots du dico pouvant être formés à partir de lettres adjacentes de la grille.

Voici déjà le classeur de base, avec :
- un range nommé grille '-----> Menu Insertion/Noms/Définir
- trois boutons de commande :
=>tirage (il fonctionne) -- Code : Sub Tirage()
=>solutions (ne fonctionne pas) -- code : Sub RetirerMotsLettresManquantes()
=>efface (il fonctionne) -- Code : Sub Efface()

Le classeur : http://cjoint.com/?DBgpyvwtxf3

Pour celles et ceux qui n'aiment pas trop télécharger via des sites de pièce jointe, envoyez moi votre mail perso via MP, je vous ferais un envoi particulier.

Merci d'avance.
Cordialement,
Franck
Afficher la suite 

20/71 réponses

Messages postés
18039
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
214
0
Merci
La pêche n'a pas été bonne (because ce fichu navire espagnol qui s'est brisé en 3 à l'entrée du port et a laissé filer quelques tonnes de combustible non encore ingurgitées)...

J'ai par contre eu le temps de réfléchir, mais uniquement à l'étape qui m'émoustillait, à savoir pouvoir agir sur le dico (txt) exactement (et avec la même agilité) que sur une table de base de données.
J'envoie par email un classeur de démonstration de cette seule partie à pijaku, après le repas. Je suis sûr qu'il y trouvera quelques choses à prendre au vol, dont les vitesses de chargement.
A Pijaku : je ne vois que des avantages à ce que tu montres la solution à laquelle tu es déjà parvenu.
ucfoutu
Messages postés
18039
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
214 -
Il n'échappera pas que, dès lors que les requêtes peuvent être ainsi "agilisées" (sans boucle), on peut limiter la liste des mots où "fouiller" à celle des mots dont AUCUNE lettre n'est l'une des lettres de l'alphabet ABSENTES de la grille.
Testé : recherche des mots ne contenant aucune de ces lettres : "H", "O", "P", "E", "A", "D", "K", "Y", "Z", "L", "N" ===>> liste de 287 mots extraite du dico en 0,75 secondes ! Intéressant, non ?

PS ! et inutile d'attendre que la grille soit remplie pour déterminer les lettres de l'alphabet qui y sont absentes.
Il suffit, juste avant le tirage, de constituer une collection (A,B,C,D ....X,Y,Z) puis, à chaque lettre tirée (dans le module de tirage) de retirer cette lettre de la collection (avec au besoin un on error pour le cas où déjà plus dans la collection). Routes celles restant dans la collection sont ainsi les lettres de l'alphabet absentes de la grille..
De cette manière, le joueur n'a même pas le temps de dire ouf et ne s'aperçoit même pas du travail fait en même temps que le tirage.
Whismeril
Messages postés
13958
Date d'inscription
mardi 11 mars 2003
Statut
Contributeur
Dernière intervention
13 novembre 2019
319 -
Je n'ai pas essayé ça, je m'étais contenté de réduire par les mots commençant par le chemin en cours.
Cette première réduction du dico doit effectivement faire gagner du temps par la suite.
Je reviens vers vous une fois testé.

PS: j'ai effectué plusieurs centaines de tirage pour essayer de trouver aléatoirement une grille ayant au moins un mot de onze lettres ou plus. J'en ai trouvé une! Je la posterai plus tard.
ucfoutu
Messages postés
18039
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
214 -
j'ai effectué plusieurs centaines de tirage pour essayer de trouver aléatoirement une grille ayant au moins un mot de onze lettres ou plus. J'en ai trouvé une!
tu as eu de la patience ! J'avais essayé et abandonné.
Il reste qu'il sera assez rare de "tomber" sur une telle grille. Dans la très grande majorité des cas : la grille comportant 16 lettres distinctes maximum (car moins si lettres en double, triple, etc..) et l'alphabet 26, on pourra écarter un grand nombre de mots qui contiennent l'une des au moins 10 lettres absentes. Ce nombre sera très rarement faible (et la recherche sera alors ralentie) et très souvent élevé (et la recherche sera alors accélérée de manière significative).
Dites-moi tous les deux lorsque vous aurez fait votre dico comme dit juste plus haut.
Je vous montrerai alors code et requêtes non dénuées d'intérêt.
Whismeril
Messages postés
13958
Date d'inscription
mardi 11 mars 2003
Statut
Contributeur
Dernière intervention
13 novembre 2019
319 -
De la patience non!
J'ai fait une boucle de 100 tirages qui se stoppe si un mot de onze lettres au moins existe.
J'ai lancé cette boucle toute la soirée jusqu'à ce qu'elle obtienne un résultat.

Pour le dico, le format type csv me va très bien vu que je le charge dans une liste de string.
ucfoutu
Messages postés
18039
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
214 -
tu as donc bien maintenant un fichier ainsi constitué :

mot
ABAISSA
ABAISSABLE
etc ...

dont la 1ère ligne dit "mot" ?
Commenter la réponse de ucfoutu
Messages postés
12253
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
19 juillet 2019
7
0
Merci
Bonjour,

@Noctambule : merci! Et c'est loin d'être terminé.
C'est vrai que, grâce à l'équipe présente ici, je retrouve un esprit communautaire assez puissant. On "s'amuse" en créant un jeu le mieux possible. En plus, j'apprends (et les autres également je supposes) énormément. On est dans l'esprit CS/CCM...
A renouveler, mais compte sur moi pour ça, des sujets j'en ai bien d'autres...

Aux 2 comparses :
Voici les fichiers :
le fichier Dico et compteur.txt.
Attention, si le site de pièce jointe à renommer ce fichier, renommez le bien : Dico et compteur.txt

Le fichier .xlsx
(@ ucfoutu : je te les ai envoyé par email)

Placez les 2 fichiers dans le même répertoire.

A l'ouverture du classeur, il va charger les données du dico en Feuil3.

Feuil1 : 3 boutons : Tirage, Solutions, Effacer
Tirage dure environ 5 secondes et :
- effectue le tirage des 16 dés aléatoirement
- effectue le tri de la liste des 323782 mots pour n'en garder qu'un millier (plus ou moins selon le tirage)
- saisi en feuil2 la durée du tirage effectué + les lettres composant ce tirage

Solutions dure moins de 10 secondes
- liste toutes les solutions dans les bonnes colonnes
- saisi en feuil2 la durée de cette recherche et le nombre de solutions trouvées
- liste également, entre parenthèses, le chemin parcouru (cf : numérotation de la grille). Au départ cette option me permet de vérifier les chemins. A terme je vais la garder pour coloriser les chemins trouvés, en cliquant sur une des solutions, en cas de suspicion par le joueur...

Effacer efface la liste des solutions

En feuil2 : un récap des tirages que j'ai effectué pour tests.
+ les 2 plus longs mots trouvés (10 lettres)

Voila.
Ah oui, le principal...
Les procédures sont dans le module procédures... Les fonctions sont dans le module fonction...

Vous y verrez notamment :
- la fonction récursive de recherche
- une fonction trouvée sur le Net qui permet d'ôter, à un objet Range, un objet range... Vachement pratique dans mon cas.

N'ayant pas trop le temps aujourd'hui, je vais juste placer tous ces codes dans une autre réponse, et j'essaie de revenir demain (lundi au plus tard) pour de plus amples explications...
Madame attendant un heureux événement, je dois faire quelques travaux dans la maison...

Amicalement,
Franck

pijaku
Messages postés
12253
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
19 juillet 2019
7 -
Salut,
Merci du retour.

J'ai enlevé le "\", mais pas dans la variable chemin, dans le QueryTables.Add :
Chemin = ThisWorkbook.Path & "\"
With Feuille 'Transfère les données du fichier texte dans la feuille : "Feuil3"
    With .QueryTables.Add(Connection:="TEXT;" & Chemin & "Dico et compteur.txt", Destination:=.Range("$A$1"))
        .Name = "aa"


Le résultat est le même.

Sans le chargement de dico à l'ouverture et avec un chargement de la liste des mots possibles entre 0,5 et 0,8 secondes, je signes des deux mains! Merci!
En fait, ce gain de temps de chargement et le fait d'alléger encore le classeur va permettre, à terme, d'augmenter "l'esthétisme" et la jouabilité que je compte mettre en place la semaine prochaine. En effet, comme le dit si bien Whismeril :
Je travaille un peu la présentation, car si je poste le projet complet, il ne faut pas que ce soit trop moche quand même.

ps : @Noctambule : que penserais tu si, à la fin de ce thread, étaient postés :
- ici en SourceS, par Whismeril, la version en C#
- toujours ici, en SourceS, par Ucfoutu, la version VBA (la majeure partie des codes venant de lui)
- Sur CCM, en lieu et place de mon "astuces" originelle, ma version "designée"...

Cela ne ferait pas trop "doublonnage"?
Quand même...
Du coup, je ne sais plus.

ps2 : bon je retourne à mon isolation...
noctambule28
Messages postés
29639
Date d'inscription
samedi 12 mai 2007
Statut
Webmaster
Dernière intervention
13 novembre 2019
2 -
Ca ne fera pas doublonnage , il y a du C#, du VBA, et du "fini exploitable".
J'irais même plus loin, il faut lié les 3 entre eux et avec ce thread également qui à lui seul représente "la mécanique" pour arriver au résultat et qui est un excellent exemple de travail d'équipe.
BunoCS
Messages postés
14656
Date d'inscription
lundi 11 juillet 2005
Statut
Modérateur
Dernière intervention
13 novembre 2019
90 -
Je plussoie!
Beau travail d'équipe!
Whismeril
Messages postés
13958
Date d'inscription
mardi 11 mars 2003
Statut
Contributeur
Dernière intervention
13 novembre 2019
319 -
@Noc et Buno, je suis bientôt prêt à poster le code, mais en plus de ce thread j'aimerais expliquer le pourquoi du comment.
Bien sûr j'essaie de commenter au mieux le code mais ça ne fait pas tout.

Si je poste dans les codes sources, puis je me vendre d'une belle littérature dans la description ou alors je fais un tuto?
Seulement "Faire un Boggle en C#" est ce vraiment un sujet de tuto?
BunoCS
Messages postés
14656
Date d'inscription
lundi 11 juillet 2005
Statut
Modérateur
Dernière intervention
13 novembre 2019
90 -
Hello Whis !
Soit tu écris effectivement une belle description pour la source, soit tu t'arranges pour en faire un tuto, non pas "Faire un Boggle" mais plutôt "Explication de l'algo du Boggle", ou équivalent. Cette 2e solution à l'avantage de pouvoir "proprement" faire des liens vers les sources de pijaku et ucfoutu, mais aussi vers ce thread.
Qu'en penses/ez-tu/vous?
Commenter la réponse de pijaku
Messages postés
12253
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
19 juillet 2019
7
0
Merci
Les codes :


Dans le module ThisWorkbook
Option Explicit

'--------------- CREATION DU DICTIONNAIRE (à partir du dictionnaire txt joint au classeur)
'A L'OUVERTURE DU CLASSEUR
Private Sub Workbook_Open()
'Sources : ucfoutu
'http://codes-sources.commentcamarche.net/forum/affich-10019292-vba-excel-recursivite-jeu-du-boggle#82
Dim Chemin As String

Set Feuille = Sheets("Feuil3")
Chemin = ThisWorkbook.Path & "\"
With Feuille 'Transfère les données du fichier texte dans la feuille : "Feuil3"
    With .QueryTables.Add(Connection:="TEXT;" & Chemin & "Dico et compteur.txt", Destination:=.Range("$A$1"))
        .Name = "aa"
        .FieldNames = True
        .SaveData = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = True
        .Refresh BackgroundQuery:=False
    End With
End With
Sheets("Feuil1").Select
End Sub

'--------------- DESTRUCTION DU DICTIONNAIRE
'A LA FERMETURE DU CLASSEUR
Private Sub Workbook_BeforeClose(Cancel As Boolean)
With Sheets("Feuil3")
    .Columns("A:AA").Delete Shift:=xlToLeft
End With
Sheets("Feuil1").Select
ThisWorkbook.Save
End Sub


Dans le module de la Feuil1 :
Option Explicit

'--------------- EFFACE LES SOLUTIONS
Private Sub CommandButton1_Click()
Rows("11:1000").Delete Shift:=xlUp
Sheets("Feuil1").Range("Q10").ClearContents
End Sub

'--------------- TIRAGE
Private Sub CommandButton2_Click()
Call Tirage 'code dans le Module Procédures
End Sub

Private Sub CommandButton3_Click()
Call Solutions 'code dans le Module Procédures
End Sub


Le Module Procédures :
Option Explicit

'--------- Module contenant les procédures nécessaires au jeu ------------------


Public DicoReduit As Object
Public Feuille As Worksheet
Public CelVoisines(15) As Range, Cellules, Chemin(), ListeMots(), Voisines(15) As Range
Dim t As Single


'--------------- TIRAGE ALEATOIRE DES 16 LETTRES
Sub Tirage() 'Cette procédure est commandée par le bouton TIRAGE (Cf : Module Feuil1)
Dim cubes As Variant, Cel As Range, cpt As Byte, tirag As String

t = Timer
 'la grille choisie : Range("D3:G6")
Sheets("Feuil1").Range("Grille").ClearContents
Randomize Timer
cubes = Array("ETUKNO", "EVGTIN", "IELRUW", "DECAMP", "EHIFSE", "RECALS", "ENTDOS", "OFXRIA", "NAVEDZ", "EIOATA", "GLENYU", "BMAQJO", "TLIBRA", "SPULTE", "AIMSOR", "ENHRIS")
touille_cubes cubes '----- MERCI UCFOUTU !
cpt = 0
tirag = ""
For Each Cel In Range("Grille")
    Cel.Value = Mid(cubes(cpt), CInt((5 * Rnd()) + 1), 1)
    cpt = cpt + 1
    tirag = tirag & Cel.Value & " - "
Next Cel
Sheets("Feuil2").Columns(3).Find("*", , , , xlByColumns, xlPrevious).Offset(1, 0) = "Tirage " & Left(tirag, Len(tirag) - 3) & " en : " & Timer - t & " secondes."
Call TriDicoEnFonctionTirage
End Sub
        'Mélange les dés
Private Sub touille_cubes(ByRef cubes)
'Sources : ucfoutu
'http://codes-sources.commentcamarche.net/forum/affich-10019292-vba-excel-recursivite-jeu-du-boggle#41
 Dim i As Integer, nb As Integer, ou As Integer
 Dim temp As String
 
 nb = UBound(cubes)
 For i = 0 To nb / 2
   ou = Int(((15 - i) * Rnd))
   temp = cubes(ou)
   cubes(ou) = cubes(nb - i)
   cubes(nb - i) = temp
 Next
End Sub


Sub TriDicoEnFonctionTirage()
Dim Tb(), OccurLettres As Object, Cel As Range, i As Long, j As Byte, Flag As Boolean

Set Feuille = Sheets("Feuil3")
Set OccurLettres = CreateObject("Scripting.Dictionary")
For Each Cel In Range("Grille")
    OccurLettres(Cel.Value) = OccurLettres(Cel.Value) + 1
Next Cel
Set DicoReduit = CreateObject("Scripting.Dictionary")
Tb = Feuille.Range("A1:AA" & Feuille.Range("A" & Rows.Count).End(xlUp).Row).Value
For i = LBound(Tb) To UBound(Tb)
    Flag = True
    For j = 2 To 27
        If Tb(i, j) <> "" Then
            If Tb(i, j) > OccurLettres(Chr(63 + j)) Or Not OccurLettres.Exists(Chr(63 + j)) Then Flag = False: Exit For
        End If
    Next
    If Flag Then DicoReduit(Tb(i, 1)) = ""
Next i
ListeMots = DicoReduit.Keys
Sheets("Feuil2").Columns(1).Find("*", , , , xlByColumns, xlPrevious).Offset(1, 0) = "Tirage en : " & Timer - t & " secondes."
End Sub

Sub Solutions()
Dim strText As String, Cel As Range, CptResult As Long, Resultats(), i As Long, j As Integer, route()

t = Timer
'Numérotation des cellules de 0 à 15, dans cet ordre :
Cellules = Array("$D$3", "$E$3", "$F$3", "$G$3", "$D$4", "$E$4", "$F$4", "$G$4", "$D$5", "$E$5", "$F$5", "$G$5", "$D$6", "$E$6", "$F$6", "$G$6")
'Boucle sur les mots de la liste
For i = LBound(ListeMots) To UBound(ListeMots)
    strText = ListeMots(i) '"REEES" '
    '-------------------- Recherche de la 1ère lettre du mot dans la grille
    For Each Cel In Sheets("Feuil1").Range("Grille")
        If Cel.Value = Left(strText, 1) Then
            'Initialisation des variables tableaux représentants les cellules et leurs voisines
            Initialisation
            '---------- Lettre trouvée
            Erase Chemin ' = nouveau chemin
            ReDim Preserve Chemin(0)
            Chemin(0) = Application.Match(Cel.Address, Cellules, 0) - 1 ' Chemin(0) = n° de la cellule
            Call Retire(Cel.Address)
            For j = LBound(CelVoisines) To UBound(CelVoisines)
                Set Voisines(j) = CelVoisines(j)
            Next j
            If SolucesRecurs(strText, 2) = True Then
                ReDim Preserve Resultats(CptResult)
                Resultats(CptResult) = strText
                ReDim Preserve route(CptResult)
                For j = LBound(Chemin) To UBound(Chemin)
                    route(CptResult) = route(CptResult) & Chemin(j) & " - "
                Next j
                route(CptResult) = Left(route(CptResult), Len(route(CptResult)) - 3)
                CptResult = CptResult + 1
            End If
        End If
    Next Cel
Next i
Sheets("Feuil1").Range("Q10") = CptResult & " mots trouvés en : " & Timer - t & " secondes."
Sheets("Feuil2").Columns(2).Find("*", , , , xlByColumns, xlPrevious).Offset(1, 0) = CptResult & " mots trouvés en : " & Timer - t & " secondes."
For i = LBound(Resultats) To UBound(Resultats)
    Sheets("Feuil1").Cells(Columns(Len(Resultats(i))).Find("*", , , , xlByColumns, xlPrevious).Row + 1, Len(Resultats(i))) = Resultats(i) & "  (" & route(i) & ")"
Next i
End Sub

Sub Retire(Cellu As String)
'Retire de toutes les "Cellules voisines", la cellule initiale trouvée dans la proc "Solutions"
Dim i As Byte, monRng As Range

Set monRng = Sheets("Feuil1").Range(Cellu)
For i = LBound(CelVoisines) To UBound(CelVoisines)
    If Not Application.Intersect(CelVoisines(i), monRng) Is Nothing Then
        Set CelVoisines(i) = SubtractFirstPrinciples(CelVoisines(i), monRng)
    End If
Next i
End Sub

Sub Initialisation()
'Voisines de "D3" pour le Chemin : D3 = 0
Set CelVoisines(0) = Sheets("Feuil1").Range("$E$3,$D$4:$E$4")
'Voisines de "E3" pour le Chemin : E3 = 1
Set CelVoisines(1) = Sheets("Feuil1").Range("$D$3,$F$3,$D$4:$F$4")
'Voisines de "F3" etc....
Set CelVoisines(2) = Sheets("Feuil1").Range("$E$3,$E$4:$G$4,$G$3")
Set CelVoisines(3) = Sheets("Feuil1").Range("$F$3,$F$4:$G$4")
Set CelVoisines(4) = Sheets("Feuil1").Range("$D$3:$E$3,$E$4,$D$5:$E$5")
Set CelVoisines(5) = Sheets("Feuil1").Range("$D$3:$F$3,$D$4,$F$4,$D$5:$F$5")
Set CelVoisines(6) = Sheets("Feuil1").Range("$E$3:$G$3,$E$4,$G$4,$E$5:$G$5")
Set CelVoisines(7) = Sheets("Feuil1").Range("$F$3:$G$3,$F$4,$F$5:$G$5")
Set CelVoisines(8) = Sheets("Feuil1").Range("$D$4:$E$4,$E$5,$D$6:$E$6")
Set CelVoisines(9) = Sheets("Feuil1").Range("$D$4:$F$4,$D$5,$F$5,$D$6:$F$6")
Set CelVoisines(10) = Sheets("Feuil1").Range("$E$4:$G$4,$E$5,$G$5,$E$6:$G$6")
Set CelVoisines(11) = Sheets("Feuil1").Range("$F$4:$G$4,$F$5,$F$6:$G$6")
Set CelVoisines(12) = Sheets("Feuil1").Range("$D$5:$E$5,$E$6")
Set CelVoisines(13) = Sheets("Feuil1").Range("$D$5:$F$5,$D$6,$F$6")
Set CelVoisines(14) = Sheets("Feuil1").Range("$E$5:$G$5,$E$6,$G$6")
Set CelVoisines(15) = Sheets("Feuil1").Range("$F$5:$G$5,$F$6")
End Sub


Le module Fonctions :
Option Explicit

'--------- Module contenant les fonctions nécessaires au jeu ------------------


Function SolucesRecurs(Mot As String, i As Byte) As Boolean
Dim j As Byte, indic As Byte, rng As Range

If i = 0 Then
    SolucesRecurs = False
Else
    If i <= Len(Mot) Then
        Set rng = Voisines(Chemin(UBound(Chemin))).Cells.Find(Mid(Mot, i, 1))
        If Not rng Is Nothing And DejaPasseParIci(rng) = False Then
            'Debug.Print rng.Address
            If Len(Voisines(Chemin(UBound(Chemin))).Address) > 4 Then
                If Not Application.Intersect(Voisines(Chemin(UBound(Chemin))), rng) Is Nothing Then
                    'Debug.Print Voisines(Chemin(UBound(Chemin))).Address
                    Set Voisines(Chemin(UBound(Chemin))) = SubtractFirstPrinciples(Voisines(Chemin(UBound(Chemin))), rng)
                    'Debug.Print Voisines(Chemin(UBound(Chemin))).Address
                End If
                indic = UBound(Chemin) + 1
                ReDim Preserve Chemin(indic)
                Chemin(indic) = Application.Match(rng.Address, Cellules, 0) - 1
                SolucesRecurs = SolucesRecurs(Mot, i + 1)
            ElseIf UBound(Chemin) = 0 Then
                SolucesRecurs = False
            Else
                indic = UBound(Chemin) - 1
                ReDim Preserve Chemin(indic)
                SolucesRecurs = SolucesRecurs(Mot, i - 1)
            End If
        ElseIf Not rng Is Nothing And DejaPasseParIci(rng) = True Then
            If Not Application.Intersect(Voisines(Chemin(UBound(Chemin))), rng) Is Nothing Then
                'Debug.Print Voisines(Chemin(UBound(Chemin))).Address
                Set Voisines(Chemin(UBound(Chemin))) = SubtractFirstPrinciples(Voisines(Chemin(UBound(Chemin))), rng)
                'Debug.Print Voisines(Chemin(UBound(Chemin))).Address
            End If
            SolucesRecurs = SolucesRecurs(Mot, i) ' i + 1 ********************
        Else
            If UBound(Chemin) > 0 Then

                indic = UBound(Chemin) - 1
                ReDim Preserve Chemin(indic)
                '*************************************************************
                SolucesRecurs = SolucesRecurs(Mot, i - 1)
            Else
                SolucesRecurs = False
            End If
        End If
    Else
        SolucesRecurs = True
    End If
End If
End Function

Function DejaPasseParIci(Cel As Range) As Boolean
Dim i As Integer
DejaPasseParIci = False
If Cel Is Nothing Then DejaPasseParIci = True: Exit Function
For i = LBound(Chemin) To UBound(Chemin)
    If Cellules(Chemin(i)) = Cel.Address Then DejaPasseParIci = True: Exit For
Next i
End Function

'Sources : Tushar Mehta (profil : http://dailydoseofexcel.com/archives/author/Tushar-Mehta/)
'http://dailydoseofexcel.com/archives/2007/08/17/two-new-range-functions-union-and-subtract/
Function SubtractFirstPrinciples(Rng1 As Range, Rng2 As Range) As Range
    On Error Resume Next
    If Application.Intersect(Rng1, Rng2).Address <> Rng2.Address Then Exit Function
    On Error GoTo 0
    Dim aCell As Range
    For Each aCell In Rng1
        Dim Rslt As Range
        If Application.Intersect(aCell, Rng2) Is Nothing Then
            Set Rslt = Union(Rslt, aCell)
        End If
        Next aCell
    Set SubtractFirstPrinciples = Rslt
End Function
    
Function Union(Rng1 As Range, Rng2 As Range) As Range
    If Rng1 Is Nothing Then
        Set Union = Rng2
    ElseIf Rng2 Is Nothing Then
        Set Union = Rng1
    Else
        Set Union = Application.Union(Rng1, Rng2)
    End If
End Function


Comme dis précédemment, je reviens donner des explications sur ces différents choix... Mais pas aujourd'hui.
Merci de votre compréhension et du suivi.
Bon week end.
Commenter la réponse de pijaku
Messages postés
18039
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
214
0
Merci
Bon ...

Je voudrais que l'on s'attarde à ce mécanisme, pour tout ce qu'il apporte (pas seulement pour ce jeu) à bien des égards.


Pour cette démo, il est important de constituer comme je l'ai dit plus haut, un fichier texte nommé dico3.txt et qui doit revêtir exactement cette forme :
En toute première ligne : mot
les lignes suivantes : un mot du dictionnaire par ligne et donc ===>>

mot
ABAISSA
ABAISSABLE
ABAISSABLES
.
.
.
ZYMASE
ZYMASES
ZYTHONS





ouvrir un nouveau classeur
sur sa feuille 1 insérer ces boutons de commande, de grande largeur :
- commandbutton1 avec caption : "importer tous les mots"
- commandbutton2 avec caption : "importer uniquement les mots de 4 lettres"
- commandbutton3 avec caption : "n'importer que les mots commençant par CO"
- commandbutton4 avec caption : "n'importer que les mots ne contenant ni H, ni O, ni P, ni E, ni A, ni D"
- commandbutton5 avec caption : "importer tous les mots commençant par CO et contenant "DA""
- commandbutton6 avec caption : "importer les mots commençant par "CA" et ne contenant ni D, ni O, ni U, ni E"
- commandbutton7 avec caption : "mporter les mots commençant par "PR" ET contenant les lettres U , H & O et les TRIER par nombre de lettres"
- commandbutton2 avec caption : "importer uniquement les mots de 5 lettres commençant par "LU""


Dans outils : cocher la référence disant :" Microsoft Acxtivex Data Objects 2.0 Library"

Le code, maintenant :


Option Explicit
Private requete As String, deb As Double, cible As Range
Const ou As String = "A1"
Const dossier As String = "D:\pijaku" '====>>> remplacer bien sur par le chemin du dossier contenant le dico dico3.txt



Private Sub CommandButton1_Click()
Columns("A").ClearContents
deb = Timer
Application.ScreenUpdating = False
requete = "SELECT mot FROM dico3.csv"
ext_don requete
Columns("A").AutoFit
Application.ScreenUpdating = True
MsgBox " en " & Timer - deb & " seconde(s)"
End Sub


Private Sub CommandButton2_Click()
Columns("A").ClearContents
deb = Timer
Application.ScreenUpdating = False
requete = "SELECT mot FROM dico3.txt WHERE len(mot) = 4"
ext_don requete
Columns("A:IV").AutoFit
Application.ScreenUpdating = True
MsgBox " en " & Timer - deb & " seconde(s)"
End Sub

Private Sub CommandButton3_Click()
Columns("A").ClearContents
deb = Timer
Application.ScreenUpdating = False
requete = "SELECT mot FROM dico3.txt WHERE mot like 'CO%'"
ext_don requete
Columns("A:IV").AutoFit
Application.ScreenUpdating = True
MsgBox " en " & Timer - deb & " seconde(s)"
End Sub

Private Sub CommandButton4_Click()
Columns("A").ClearContents
Dim filtre As String, i As Integer, sep As String, titi
deb = Timer
Application.ScreenUpdating = False
titi = Array("H", "O", "P", "E", "A", "D", "K", "Y", "Z", "L", "N")
For i = 0 To UBound(titi)
sep = IIf(i = 0, "", ",")
filtre = filtre & sep & titi(i)
Next
filtre = "%[" & filtre & "]%"
requete = "SELECT mot FROM dico3.txt WHERE mot not like '" & filtre & "'"
ext_don requete
Columns("A:IV").AutoFit
Application.ScreenUpdating = True
MsgBox " en " & Timer - deb & " seconde(s)"
End Sub

Private Sub CommandButton5_Click()
Columns("A").ClearContents
deb = Timer
Application.ScreenUpdating = False
requete = "SELECT mot FROM dico3.txt WHERE mot like 'CO%' and mot like '%DA%'"
ext_don requete
Columns("A:IV").AutoFit
Application.ScreenUpdating = True
MsgBox " en " & Timer - deb & " seconde(s)"
End Sub

Private Sub CommandButton6_Click()
Columns("A").ClearContents
Dim filtre As String, i As Integer, sep As String, titi
deb = Timer
Application.ScreenUpdating = False
titi = Array("D", "O", "U", "E")
For i = 0 To UBound(titi)
sep = IIf(i = 0, "", ",")
filtre = filtre & sep & titi(i)
Next
filtre = "%[" & filtre & "]%"
requete = "SELECT mot FROM dico3.txt WHERE mot not like '" & filtre & "' and mot like 'CA%'"
ext_don requete
Columns("A").AutoFit
Application.ScreenUpdating = True
MsgBox " en " & Timer - deb & " seconde(s)"
End Sub

Private Sub CommandButton7_Click()
Columns("A").ClearContents
Dim filtre As String, titi
deb = Timer
Application.ScreenUpdating = False
titi = Array("H", "O", "U")
filtre = "%[" & filtre & "]%"
requete = "SELECT mot FROM dico3.txt WHERE mot like 'PR%' and mot like '%[" & _
titi(0) & "]%' and mot like '%[" & titi(1) & "]%' and mot like '%[" & titi(2) & "]%' order by len(mot)"
ext_don requete
Columns("A:IV").AutoFit
Application.ScreenUpdating = True
MsgBox " en " & Timer - deb & " seconde(s)"

End Sub
Private Sub CommandButton8_Click()
Columns("A").ClearContents
deb = Timer
Application.ScreenUpdating = False
requete = "SELECT mot FROM dico3.txt WHERE len(mot) = 5 and mot like 'LU%'"
ext_don requete
Columns("A:IV").AutoFit
Application.ScreenUpdating = True
MsgBox " en " & Timer - deb & " seconde(s)"
End Sub


'==================================================
Sub ext_don(requete As String)
Set cible = Range(ou)
Dim connex As ADODB.Connection, jeu_enr As ADODB.Recordset, i As Integer
If cible Is Nothing Then Exit Sub
Set connex = New ADODB.Connection
On Error Resume Next
connex.Open "Driver={Microsoft Text Driver (*.txt; *.csv)};" & "Dbq=" & dossier & ";" & _
"Extensions=asc,csv,tab,txt;"
On Error GoTo 0
If connex.State <> adStateOpen Then Exit Sub
Set jeu_enr = New ADODB.Recordset
On Error Resume Next
jeu_enr.Open requete, connex, adOpenForwardOnly, adLockReadOnly, adCmdText
On Error GoTo 0
If jeu_enr.State <> adStateOpen Then
connex.Close
Set connex = Nothing
Exit Sub
End If
'For i = 0 To jeu_enr.Fields.Count - 1
'cible.Offset(0, i).Formula = jeu_enr.Fields(i).Name
'Next i
'cible.Offset(1, 0).CopyFromRecordset jeu_enr
cible.CopyFromRecordset jeu_enr
jeu_enr.Close
Set jeu_enr = Nothing
connex.Close
Set connex = Nothing
End Sub


Lancer et observer la puissance, pour chacun des boutons de commandes.
Ce n'est pas par hasard, que j'ai mis tous ces exemples de possibilités (parmi d'autres) offertes

A LAQUELLE CONVIENT-IL DE S'ATTARDER, à ce stade ? :
A l'exemple du commandbutton4, qui correspond parfaitement à tes vrais besoins à ce stade.
Tu auras vite compris que l'ARRAY titi contient une liste des lettrres de l'alphabet que l'on ne veut pas dans les mots sélectionnés et que c'est à parir de cet ARRAY que je construis un filtre utilisé dans la requête.
Que faire, dans ton jeu ? ===>> la même chose, mais à partir d'une collection A,B,C,....X,Y,Z dont tu auras retiré chaque lettre tirée aléatoirement (au moment même du tirage). La collection "résiduelle" ainsi obtenue est précisément la liste des lettres de l'alphabet qui ne doivent pas figurer dans les mots sélectionnés. Observe sa rapidité.
Ses résultats sont par ailleurs tels (liste à ce point réduite), que l'on peut, du coup, ne pas faire les frais d'une épuration supplémentaire (à partir du nombre de chacune des lettres d'un mot) et que l'on peut aller directement à la recherche récursive.

PS : j'ai mis là le code qui traite un fichier texte d'une seule colonne, pour des raisons de simplification (pour ce jeu). Je précise que je sais bien sûr également écrire le code qui traiterait en base de données un fichier texte de plusieurs colonnes. Je ferai au besoin plus tard un petit tuto à ce sujet, compte tenu de l'intérêt de ce mécanisme.




________________________
Réponse exacte ? => "REPONSE ACCEPTEE" facilitera les recherches.
Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement répéter son contenu. Je n'interviend
Whismeril
Messages postés
13958
Date d'inscription
mardi 11 mars 2003
Statut
Contributeur
Dernière intervention
13 novembre 2019
319 -
Bonsoir, Uc, tout d'abord merci pour ton idée limiter le dictionnaire aux mots contenant les lettres tirées.
Je l'ai appliquée et sur le tirage ou je trouvais 245 mots en 4,9 secondes et bien j'en trouve maintenant 250 en 0,7 secondes!
Les cinq mots supplémentaires sont liés à un problème d'import du dico qui faisait que je corrompais le premier mot de chaque ligne.

Par contre le gain de temps est dû uniquement à ton idée.

Je me suis confronté à l'évaluation différée des requêtes Linq, ce qui dans certains cas apporte un gain, d'en d'autre une perte voire un bug.
A force de bidouille, entre l'utilisation de linq ou des outils de base des List<T> je crois avoir trouvé le meilleur compromis.

Encore merci.
Whismeril
Messages postés
13958
Date d'inscription
mardi 11 mars 2003
Statut
Contributeur
Dernière intervention
13 novembre 2019
319 -
Concernant ton code VBA, je tacherais de le tester la semaine prochaine (je n'ai pas excel chez moi....)
Mais j'ai une crainte quand je lis que tu concatènes les lettres à exclure pour en faire un filtre.
titi = titi = Array("H", "O", "P", "E", "A", "D", "K", "Y", "Z", "L", "N")
   For i = 0 To UBound(titi)
     sep = IIf(i = 0, "", ",")
      filtre = filtre & sep & titi(i)
    Next
    filtre = "%[" & filtre & "]%"
    requete = "SELECT mot FROM dico3.txt WHERE mot not like '" & filtre & "'"


Ca te jette tous les mots qui contiennent toutes ces lettres? Dans l'ordre? Ou une des ces lettres?
ucfoutu
Messages postés
18039
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
214 -
Cela exclut tous les mots qui contiendraient une ou plusieurs de ces lettres (puisqu'absentes dans la grille), quel que soit l'ordre de présence de ces lettres dans le mot. Regarde bien le filtre, qui joue avec la puissance de l'opérateur Like (clin d'oeil).******
C'est là, tout l'intérêt.

PS : je dois confesser que la recherche de mécanismes pouvant aider au développement de ce jeu a fini (en ce qui me concerne) par me faire découvrir qu'il n'était pas idiot (et que c'était possible) d'utiliser le jet/système. Je n'y avais jamais pensé et découvre (force est pour moi de le constater) que c'est possible et agile. A ce point agile que ce mécanisme peut faire "plus rapide" que l'utilisation de tableaux dynamiques croisés ! En parlant de ces tableaux dynamiques croisés : ce sont cependant eux, qui m'ont encouragé à fouiller plus en profondeur (je me disais bien qu'ils devaient forcément passer eux-mêmes par l'utilisation d'un jet ... et que ce jet était donc probablement présent sur la machine) et ....===>> bingo !)

PS : je disais plus haut que mon intérêt, dans cette affaire, dépassait celui de ce jeu. Et rien n'est plus vrai !
Tiens : prenons par exemple la demande récemment faite à propos d'une cave à vins et de mes réponses/solutions y apportées. Mes réponses seraient AUJOURD'HUI complètement différentes et mes
solutions plus complètes et agiles encore.

***** Le filtre n'est pas une simple concaténation des lettres. Regarde-le bien : il est une chaîne constituée de lettres séparées par des virgules, le tout entre crochets ([ ]).
Je te concède que l'aide sur Like est incomplète. C'est un défaut de Microsoft, que d'être incomplet dans ses aides. Tel est également le cas en ce qui concerne d'autres aides, dont celle à propos de l'utilisation de l'instruction Format (entre autres).
Commenter la réponse de ucfoutu
Messages postés
18039
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
214
0
Merci
Pour pijaku

ouvre un classeur neuf, puis :
- coche la référence disant :" Microsoft Acxtivex Data Objects 2.0 Library"
- mets-y ce code dans un bouton de commande sur la feuille de ton choix :
Option Explicit
Private grille As Range
Const nom_de_mon_dico As String = "dico3.txt" ' ===>> nom SEUL du fichier texte "dictionnaire"
Const dossier_de_mon_dico As String = "d:\pijaku" ' =====>> chemin du dossier contenant le dico (sans \ final)
Const feuille_affichage As String = "Feuil3" ' ===>> nom de la feuille où afficher le résultat "réduit"
Const col_affichage As String = "A" ' ====>> colonne où afficher le résultat
Const ou_commencer_affichage As Integer = 1 '===> N° de la ligne où commencer l'affichage
Const affiche_nom_champs As Boolean = False ' ===>> True pour afficher les noms de champs en en-tête, False sinon
Const LA As String * 26 = "ABCDEFGHIJKLMNOPQRSTUV"

Private Sub CommandButton1_Click()
Dim cubes As Variant, Cel As Range, cpt As Byte, carac As Byte, filtre As String
Dim sep As String, lettres_absentes As String, deb As Double, requete As String, indesirables
Randomize Timer
lettres_absentes = LA
If grille Is Nothing Then ' pas la peine de les réinitialser si déjà fait
Set grille = Range("j11:M14")
End If
Application.ScreenUpdating = True
cpt = 0
cubes = Array("ETUKNO", "EVGTIN", "IELRUW", "DECAMP", "EHIFSE", "RECALS", "ENTDOS", "OFXRIA", "NAVEDZ", "EIOATA", "GLENYU", "BMAQJO", "TLIBRA", "SPULTE", "AIMSOR", "ENHRIS")
touille_cubes cubes '================> voir cette proc plus bas
grille.ClearContents
For Each Cel In grille
Cel.Value = Mid(cubes(cpt), CInt((5 * Rnd()) + 1), 1)
lettres_absentes = Replace(lettres_absentes, Cel.Value, "")
cpt = cpt + 1
Next Cel
indesirables = Split(StrConv(lettres_absentes, vbUnicode), Chr(0))
Worksheets(feuille_affichage).Range(col_affichage & ":" & col_affichage).ClearContents
Application.ScreenUpdating = False
deb = Timer
sep = ""
For cpt = 0 To UBound(indesirables) - 1
If cpt > 0 Then sep = ","
filtre = filtre & sep & indesirables(cpt)
Next
filtre = "%[" & filtre & "]%"
requete = "SELECT mot FROM " & nom_de_mon_dico & " WHERE mot not like '" & filtre & "'"
ext_don requete
Application.ScreenUpdating = True
MsgBox " en " & Timer - deb & " seconde(s)"
End Sub

Private Sub touille_cubes(ByRef cubes)
Dim i As Integer, nb As Integer, ou As Integer, temp As String
nb = UBound(cubes)
For i = 0 To nb / 2
ou = Int(((15 - i) * Rnd))
temp = cubes(ou)
cubes(ou) = cubes(nb - i)
cubes(nb - i) = temp
Next
End Sub
Sub ext_don(requete As String)
Dim cible As Range
Set cible = Worksheets(feuille_affichage).Range(col_affichage & ou_commencer_affichage)
Dim connex As ADODB.Connection, jeu_enr As ADODB.Recordset, i As Integer
If cible Is Nothing Then Exit Sub
Set connex = New ADODB.Connection
On Error Resume Next
connex.Open "Driver={Microsoft Text Driver (*.txt; *.csv)};" & "Dbq=" & dossier_de_mon_dico & ";" & "Extensions=asc,csv,tab,txt;"
On Error GoTo 0
If connex.State <> adStateOpen Then Exit Sub
Set jeu_enr = New ADODB.Recordset
On Error Resume Next
jeu_enr.Open requete, connex, adOpenForwardOnly, adLockReadOnly, adCmdText
On Error GoTo 0
If jeu_enr.State <> adStateOpen Then
connex.Close
Set connex = Nothing
Exit Sub
End If
If affiche_nom_champs Then
For i = 0 To jeu_enr.Fields.Count - 1
cible.Offset(0, i).Formula = jeu_enr.Fields(i).Name
Next i
cible.Offset(1, 0).CopyFromRecordset jeu_enr
End If
cible.CopyFromRecordset jeu_enr
jeu_enr.Close
Set jeu_enr = Nothing
connex.Close
Set connex = Nothing
End Sub
- modifie les valeurs des constantes en début du code pour correspondre à tes emplacements à toi, etc ...

Je te rappelle que le fichier txt (qui peut d'ailleurs également être un csv sans problème) doit être comme dit plus haut et sa première ligne doit être : mot
Lance. Tu vas vite comprendre où il te conduit : grille aléatoire remplie et "dico réduit" obtenu dans la foulée sur la feuille d'affichage que tu auras décidée.
Tu peux utiliser ton code de recherche/récursivité directement à partir de ce point-là. Ne t'embarrasse pas avec une épuration complémentaire (sur les lettres de chaque mot). La liste du dico réduit est maintenant si peu importante qu'une telle épuration complémentaire n'est plus vraiment nécessaire.

________________________
Réponse exacte ? => "REPONSE ACCEPTEE" facilitera les recherches.
Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement répéter son contenu. Je n'interviend
Commenter la réponse de ucfoutu
Messages postés
13958
Date d'inscription
mardi 11 mars 2003
Statut
Contributeur
Dernière intervention
13 novembre 2019
319
0
Merci
Bonsoir de nouvelles grilles de test et les deux anciennes mise à jours
https://dl.dropboxusercontent.com/u/29767375/Tirages.zip
Commenter la réponse de Whismeril
Messages postés
12253
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
19 juillet 2019
7
0
Merci
Bonjour,

Tout d'abord, milles excuses de vous avoir abandonné ce week-end. A la lecture ce matin de vos réponses, j'ai loupé une étape...

L'idée d'utiliser cette méthode d'import est superbe. Gain de temps d'exécution, liste réduite... Chapeau ucfoutu!

Cela m'amène à rebondir sur ce point.
Le fait de n'avoir plus à importer un dictionnaire complet de 320000 mots, permet maintenant la portabilité de ce "jeu" sous les versions d'excel < 2007. J'aime beaucoup l'idée.
Néanmoins, il me semble me souvenir que la méthode CopyFromRecordset n'est pas accessible aux versions d'Excel antérieures à 2003 (à vérifier tout de même).
Si ce n'est pas abuser à ce point du développement, peut on envisager ce même import, grâce à une connection ADO (ou autre, bien entendu) de faire en sorte que notre "boggle" soit une appli "portable" sur toutes les versions de 97 (pour les 3 derniers utilisateurs au monde) à 2013?
Il me semble (encore...) que l'on peux utiliser une variable tableau pour récupérer les données d'un champ, ce qui rendrait donc l'appli utilisable sans utiliser le CopyFromRecordset. Je vais vérifier ce point ce matin.
Mais si quelqu'un a une autre méthode, elle est la bienvenue...

En premier lieu, je vais tester tout ce qui a été écris ce week-end. Je vais faire mes exercices et reviens vers vous... N'avancez pas trop sans moi...

ps : le jeu "boggle" a toujours été un prétexte. Initialement, ce sujet était un exercice, pour moi, de récursivité, il s'est transformé rapidement en exercice de développement à plusieurs. Les idées fusent de toutes parts, les solutions techniques abondent... J'apprécie l'esprit d'équipe développé ici et réitèrerait volontiers.

ps2 : @ ucfoutu :
tu dis :
prenons par exemple la demande récemment faite à propos d'une cave à vins et de mes réponses/solutions y apportées.
Pour avoir suivi ce sujet, j'avoue ne pas trop voir par quel bout tu le saisirais... Conserver les données dans un fichier texte?
Commenter la réponse de pijaku
Messages postés
18039
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
214
0
Merci
Bonjour, Pijaku,
Cette méthode d'import fonctionne sur toutes les versions Office supérieures ou égales à 2000.
Pour les versions antérieures (mais supérieures ou égales à 97) : une seule pas une de plus) ligne de code est à changer (clin d'oeil).
Continue donc tranquillement avec ce code. Je reviendrai in fine, si tu l'estimes vraiment nécessaire, sur une compilation conditionnelle.

Pour ce qui est du reste : regarde ce que je fais du recordset jeu_enr dans le code actuel ===>> je le ferme et le détruis.
Hmmm... et ... si on ne le détruisais pas pour ensuite, à partir de lui, faire d'autres requêtes et obtenir d'autres recordset, hein ... ?
(en mettant bien sur ce jeu_enr en variable générale )...
J'attendais précisément cette réaction et ce n'est pas "pour rien" que j'ai montré un code démo dans mon message du 15 févr. 2014 à 18:13 (surtout en ce qui concerne l'utilisation de l'opérateur Like) . Teste également ce code. J'ai comme l'impression que cela va t'ouvrir d'autres horizons (des idées de travail sur des sous-recordsets tirés du premier)



________________________
Réponse exacte ? => "REPONSE ACCEPTEE" facilitera les recherches.
Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement répéter son contenu. Je n'interviend
pijaku
Messages postés
12253
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
19 juillet 2019
7 -
Bonjour,
L'opérateur Like prends, ici, toute son "ampleur".
Ton code du CommandButton4 (15 février 18:13) est tout bonnement un p'tit coup de génie.
Sissi!
Le Not Like nous donne de belles possibilités.

si on ne le détruisais pas pour ensuite, à partir de lui, faire d'autres requêtes et obtenir d'autres recordset, hein ... ?
C'est exactement ce que je me disais en testant ton code du 16 février à 18:46. Les listes de mots obtenues pourraient encore être réduites.
Je vais, pour commencer, continuer mes tests sur ton code. Ensuite, je regarderais à affiner avec les requêtes que tu nous donnait samedi...
Il y a du taf...
Commenter la réponse de ucfoutu
Messages postés
13958
Date d'inscription
mardi 11 mars 2003
Statut
Contributeur
Dernière intervention
13 novembre 2019
319
0
Merci
Bonsoir, j'ai lu vos propositions pour la publication de mon code.
Je pense suivre l'idée de pijaku, en gros limiter la description pour le code complet. Et un tuto pour la recherche récursive, mais pas pour l'import du fichier, ça ne fait que deux lignes.
Je suis booké au moins jusqu'à mercredi.

Je vous recontacte en fin de semaine. Bonne continuation à tous les deux.
ucfoutu
Messages postés
18039
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
214 -
J'ai déjà essayé avec Clone ===>> sans succès.
Et avec Filter sur le premier jeu, tout le dico est repris et pas seulement le jeu retenu ===>>> très long !

EDIT : pour être plus précis : on dirait fortement qu'en utilisant Filter, il ajoute le filtre décidé aux critères de sélection déjà existants et recrée le jeu d'enregistrement à partir de la totalité du fichier !: (pas fameux ...)
pijaku
Messages postés
12253
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
19 juillet 2019
7 -
Tu dis :
Le plus simple est de dresser ce nouveau jeu d'enregistrement à partir non du premier jeu, mais de la plage Range("A1:AXXX") où il se trouve.
Ne serais ce pas plus rapide ou plus simple encore d'utiliser une variable tableau?
Un peu dans cet esprit là :
Sub TriDicoEnFonctionTirage()
Dim Tb(), OccurLettres As Object, Cel As Range, i As Long, j As Byte, Flag As Boolean

Set Feuille = Sheets("Feuil3")
Set OccurLettres = CreateObject("Scripting.Dictionary")
For Each Cel In Range("Grille")
    OccurLettres(Cel.Value) = OccurLettres(Cel.Value) + 1
Next Cel
Set DicoReduit = CreateObject("Scripting.Dictionary")
Tb = Feuille.Range("A1:A" & Feuille.Range("A" & Rows.Count).End(xlUp).Row).Value
For i = LBound(Tb) To UBound(Tb)
    'Ici la zone ou l'on teste...
    If TEST Then DicoReduit(Tb(i, 1)) = ""
Next i
ListeMots = DicoReduit.Keys
End Sub
ucfoutu
Messages postés
18039
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
214 -
Je ne sais pas ce que tu cherches à faire (ta démarche) et ne vois pas, si grille est la grille des lettres tirées, ce que tu veux faire par :
OccurLettres(Cel.Value) = OccurLettres(Cel.Value) + 1
pijaku
Messages postés
12253
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
19 juillet 2019
7 -
C'était juste un exemple.
Pour info, ce code me servait, dans l'ancienne version (avec le fichier .txt de 27 colonnes), à compter le nombre d'occurrence, par lettre, dans la grille. Avec cette méthode, j'avais, par exemple :
OccurLettres("E") = 3

Mais je me répète, c'est juste un exemple qui illustre un tri à l'aide d'une récupération du range Sheets("Feuil3").Range("A1:A" & Sheets("Feuil3").Range("A" & Rows.Count)) dans une variable tableau. Pour ne pas vous égarer ni vous embrouiller inutilement, je n'aurais pas du mettre tout ce code, mais uniquement :
Set DicoReduit = CreateObject("Scripting.Dictionary")
Tb = Feuille.Range("A1:A" & Feuille.Range("A" & Rows.Count).End(xlUp).Row).Value
For i = LBound(Tb) To UBound(Tb)
    'Ici la zone ou l'on teste...
    If TEST Then DicoReduit(Tb(i, 1)) = ""
Next i
ListeMots = DicoReduit.Keys
End Sub
ucfoutu
Messages postés
18039
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
214 -
Je ne sais pas si vraiment plus rapide avec une boucle (pas testé).
Je vais d'abord terminer ma tentative en cours de faire des requêtes (y compris complexes) sur un la plage "A1:Axx" transformée en jeu d'enregistrement "indépendant".
J'y suis arrivé pour l'essentiel. Me restent à tester : rapidité et complexité des requêtes.
A plus
Commenter la réponse de Whismeril
Messages postés
18039
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
214
0
Merci
Premier test très encourageant :
Le dico réduit en colonne A : 2523 lignes
Requête sur la plage A1:12536 :
... where len(mot) = 4 and mot like '%BO%' ...
(donc tous les mots de 4 lettres et contenant "BO")
Nombre de mots trouvés (et mis en colonne x de la feuille Feuil3) : 14
Durée d'exécution : 0,0468 secondes


Deuxième test : requête bien plus complexe :
where len(mot) < 6 and mot like '%BO%' ORDER by len(mot)
(tous les mots de moins de 6 lettres, contenant "BO", triés par longueur de mot !)
42 mots trouvés et mis en colonne x en moins de 0,05 secondes
________________________
Réponse exacte ? => "REPONSE ACCEPTEE" facilitera les recherches.
Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement répéter son contenu. Je n'interviend
Whismeril
Messages postés
13958
Date d'inscription
mardi 11 mars 2003
Statut
Contributeur
Dernière intervention
13 novembre 2019
319 -
Bonsoir, je rebondis rapidement sur
Ce serait par contre cher payer que de tenter de réduire à nouveau cette liste pour chaque mot testé.

Je ne suis pas d'accord, le fait à chaque recursion de ne garder que les mots qui commencent par la séquence de lettre en cours permet de stopper le plus vite possible la profondeur de récursion, c'est donc un gros gain de temps sur la suite.
ucfoutu
Messages postés
18039
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
214 -
Cela est certain Whismeril, mais ce qui serait cher payer serait de lancer une requête à chacun des "pas" sur le chemin....
_______________________________________________

Je crois que le moment est venu de faire une pause "réflexion"
Efforçons-nous d'identifier le problème majeur :
Au fur et à mesure de l'avancement d'un chemin (en récursivité), on doit chercher non seulement si un mot est déjà là, mais également, si pas encore là, si une possibilité existe qu'il y ait un mot plus long commençant par les mêmes lettres.
Si un mot existe, on le comptabilise, et on continue le chemin
Si un mot n'existe pas, on cherche si existent d'autres mots commençant par ces lettres. On continue si oui, sinon on arrête ce chemin
Exemple, pour être plus clair :
j'en suis à cette chaîne (quel que soit le chemin valable de 3 cases partant d'une case "C") :DUS
1) Le mot DUS existe ==>> je le comptabilise, mais n'arrête pas pour autant le chemin. Je ne l'arrête que si aucun autre mot ne commence par DUS
2) le mot DUS n'existe pas ? ===>> je ne le comptabilise pas, mais n'arrête pas pour autant le chemin. Je ne l'arrête que si aucun autre mot ne commence par DUS
Cà, c'est clair.
Quels outils nous offre VBA, maintenant, pour tenter d'y parvenir ? ===>>
1) COUNTIF (mais uniquement pour les mots entiers)
2) Range.Find : Or, si cette méthode permet de trouver les mots entiers, elle est inadaptée pour trouver les mots "commençant par". L'utilisation de son argument XcelPart retiendrait en effet, par exemple, le mot "INDUSTRIE".
On n'a donc que deux échappatoires possibles pour ce point 2 ;
a) une requête. Mais on en a vu les inconvénients (on ne va pas tout de même pas bouffer su temps tout au long de l'avancement des chemins !)
b) une boucle. Mais elle prendra un temps proportionnel à celui du nombre des articles à parcourir (même si l'on peut la quitter dès lors qu'une occurrence est trouvée)

Que faire, dans ce cas, alors ?
Ménageons la chèvre et le choux et faisons en sorte de diminuer, une fois pour toutes, le nombre des articles de la liste à parcourir en boucle pour mener à terme ce point 2)

Je propose l'éclatement (une fois pour toutes pour chaque tirage) du sous-dico déjà obtenu en listes secondaires sur 26 colonnes : une colonne (A) pour les mots commençant par "A", une pour ceux commençant par "B", etc ...
Dès lors, pour le mot commençant par un "D" dans notre exemple, notre boucle ne sera à faire que sur une liste très réduite (celle de la colonne D)
Je parviens à faire cela en jouant sur une requête en boucle de 1 à 26 sur la plage contenant le dico réduit. J'ai juste un problème dont je n'ai pas encore compris la cause ; le temps d'exécution augmente à chaque nouveau tirage ... Je cherche ...
ucfoutu
Messages postés
18039
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
214 -
Reste à savoir si l'accomplissement de cette répartition est plus rapide par recordset ou par boucle sur un tableau.
J'ai fini et testé la méthode par recordset
Je teste demain celle en bouclant sur un tableau.
ucfoutu
Messages postés
18039
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
214 -
Ben voilà :
"éclatement "par colonnes de lettres (A,B,C ...Z) plus rapide en traitant par tableau dynamique
l' "éclatement" seul prend, selon le tirage (bien sûr) entre 0,09 secondes et 0,5 secondes
ce qui fait qu'on a un temps d'attente total moyen (différent selon tirage) de 1,2 secondes pour obtenir, par lettre (une colonne par lettre) :
les seuls mots possibles (dico réduit).
Je trouve que c'est assez rapide.
pijaku
Messages postés
12253
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
19 juillet 2019
7 -
Bonjour,

Tant que nous sommes en "pause réfléchissante", il faudrait également traiter le souci de grilles particulières.
J'ai remarqué, au cours de mes différents tests, que quelques grilles pouvaient poser souci dans le nombre de mots qu'elles engendraient.
Par exemple, la grille :
A T E C
O R S I
H G P N
U D C O
engendre, par son tirage, grâce au recordset d'ucfoutu, une liste de 79 363 mots. Le temps d'importation est acceptable (2,38 secondes), mais cette liste va être longue (trop) à traiter, dans son ensemble, en récursivité, même en l'éclatant (enfin je penses). Elle est composée, je le rappelle, des mots dont les lettres sont toutes dans la grille (exit les mots contenant une lettre indésirable).

Si je traite cette liste avec un code pour enlever les mots ne correspondants pas aux chemins de 3 lettres composés dans la grille, j'obtiens une liste de 57 330 mots en 5,54 secondes. Bof!
J'ai tenté de la traiter avec le même type de code, mais pour les chemins de 4 lettres, j'obtiens une liste de 22 097 mots en 41,55 secondes, temps d'exécution inacceptable!

Que faire, donc, en cas de tirage engendrant une liste supérieure à 11 111 mots (nombre forfaitaire imaginé par moi comme étant une charnière...)?
La solution de facilité serait de lancer automatiquement un autre tirage... Do While UBound(ListeMots) > 11111
Mais bon, il s'agit d'une solution de facilité qui ne me plait guère...

Du coup, là je sèche...
J'ai l'impression qu'on ne pourra répondre à cette question qu'une fois le code de la recherche récursive écrit. Selon la durée d'exécution de ce code, il sera, peut-être, envisageable de travailler sur de longues listes...
J'en doute quand même...
Commenter la réponse de ucfoutu
Messages postés
18039
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
214
0
Merci
Je ne crois pas qu'il soit intéressant d'établir une liste encore réduite à chacun des pas faits sur un "chemin". le temps nécessaire à la "fabrication" d'une telle liste serait en effet à multiplier par un trop grand nombre de fois. Multiplier par mille même 0,1 seconde conduit à une durée totale de ...100 secondes (c'est long !) !
C'est la raison pour laquelle je pense qu'il vaut mieux partir sur la base d'une recherche commençant, tour à tour, par chacune des lettres de la grille et avancer pas à pas sur les chemins possibles commençant à cette case de la griulle, en récursivité, en ne recherchant que dans la liste de la lettre de départ (mécanisme exposé dans mon message plus haut).

Je vais à ce propos tenter aujourd'hui de réduire encore le temps total (jusqu'à l'obtention des 26 listes "par lettre", ne contenant que les lettres non "écartées").

________________________
Réponse exacte ? => "REPONSE ACCEPTEE" facilitera les recherches.
Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement répéter son contenu. Je n'interviend
Whismeril
Messages postés
13958
Date d'inscription
mardi 11 mars 2003
Statut
Contributeur
Dernière intervention
13 novembre 2019
319 -
Au fait il y a un tout petit bug dans bouton1, on veut lire dico3.csv au lieu de dico3.txt.


Pour remplacer like, certains forums proposent les regex! Je vais essayer si le temps d'exécution est plus court que je que j'ai fait quand j'aurais un peu de temps.
ucfoutu
Messages postés
18039
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
214 -
Non. Stocker dans un fichier texte le dico réduit pour l'exploiter serait pénalisant, puisque ce dico réduit est différent à chaque tirage.
Comme je l'ai par contre dit plus haut, je suis parvenu à faire des recordsets à partir du premier recordset (pas de tremplin fichier.txt, donc).
Mais cette méthode (qui fonctionne très bien) s'avère plus lente que l'utilisation d'un tableau dynamique créé sur la base du premier recordset (dico réduit). J'obtiens rapidement; de cette manière, tous les mots du dico réduit classés dans des colonnes correspondant à leur 1ère lettre ("baba" et "bibi" en colonne B, "toto" et "titi" en colonne T, etc ...). Comme je l'ai dit plus haut, j'atteins déjà ce résultat "éclaté" en une durée moyenne (dépend du tirage) de 1,1 seconde. Je cherche à voir si je ne peux pas encore grappiller quelques fractions de seconde.
Si vous souhaitez le code où j'en suis ===>> dites-le et je le mets là, tel qu'il est pour l'instant. Cela vous donnera peut-être des idées de perfectionnement, d'une part, mais également, d'autre part, devrait (même sans perfectionnement) vous permettre de commencer la suite (exploitation de l'éclatement fait).
Whismeril
Messages postés
13958
Date d'inscription
mardi 11 mars 2003
Statut
Contributeur
Dernière intervention
13 novembre 2019
319 -
Comme je l'ai par contre dit plus haut, je suis parvenu à faire des recordsets à partir du premier recordset (pas de tremplin fichier.txt, donc).
Au tant pour moi, j'ai lu rapidement les derniers débats et je suis passé sur l'info.

Ne maitrisant pas VBA, je ne me lancerai pas dans la construction de la suite, mais continue à apprendre avec avidité 😉
Whismeril
Messages postés
13958
Date d'inscription
mardi 11 mars 2003
Statut
Contributeur
Dernière intervention
13 novembre 2019
319 -
J'ai essayé l'exclusion des mots contenant au moins une lettre non tirée par une requête contenant une Regex.

Sur une vingtaine de tirage, 75 % à peu près sont plus rapides par cette méthode.
Le nombre de mots au final n'a pas de lien avec le temps d'exécution.
Apres je gagne quelques dizaines de millisecondes, ça n'est pas non plus transcendant.
Par contre le code est plus "joli".
Je vais donc poster cette méthode en gardant l'autre en commentaire.
pijaku
Messages postés
12253
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
19 juillet 2019
7 -
Salut,

@ Whismeril : j'avais songé à l'utilisation des expressions régulières (ou rationnelles, ou RegEx ou ReExp...) en complément de la requête "filtre" d'ucfoutu.
En VBA c'est mort! Aucune possibilité d'intégrer des regex dans une requête. La seule possibilité restante était de faire une fonction de tri avec regex... Inutile car les tableaux dynamiques sont au moins aussi rapide et ... plus souples d'utilisation.

@ucfoutu : De ceci :
admire (toujours avec ta grille exemple) le cadeau que te fait l'unique case disant D ===>> aucun mot avec D n'est retenu dans la colonne D ===>> pas la peine de continuer sur ce chemin-là ! même pas la peine de tester si commençant par DH, DP, DU ou DG ou DC (pas belle, la vie ?)
j'avais compris que l'on ne devait même pas tester DH, DP etc... Or, sans tri préalable, on a juste à tester les "voisines" de D pour se rendre compte que le chemin s'arrête là. Ok, nous sommes sur la même longueur d'ondes.
Toutefois, la boucle sur deux variables tableaux, l'une représentant la liste des mots (après ton import recordset par "filtre") et l'autre représentant les 408 chemins de 3 lettres, s'effectue entre 0,001 sec et 0,5 seconde (testé avec une liste de 76 000 mots, le temps d'exécution est de 0,44 sec) . Elle n'est à faire qu'une fois par tirage et permet :
- d'éliminer tous les mots de 3 lettres de la liste.
En effet, soit ces mots constituent une solution et on les stocke, soit non et on les élimine
- un meilleur tri pour l'éclatement par lettre. Ainsi, en effectuant ce premier tri, dans l'exemple cité ci-dessus, nous n'aurions même pas à tester la lettre "D" puisque la liste colonne 5 de la feuil3 (si tu as procédé comme moi pour l'éclatement de la liste totale des mots) serait vide.

Si tu souhaites tester, ou, le cas échéant, m'indiquer les erreurs dans le code, le voici :
Sub TroisLettres()
Dim cel As Range, cel2 As Range, cel3 As Range, Dico3L As Object, Liste(), DicoReduit As Object, i As Long, t As Single
t = Timer
Set Dico3L = CreateObject("Scripting.Dictionary")
Set DicoReduit = CreateObject("Scripting.Dictionary")
For Each cel In Range("Grille")
    For Each cel2 In cel.Offset(-1, -1).Resize(3, 3)
        If cel2.Value <> "" And cel2.Address <> cel.Address Then
            For Each cel3 In cel2.Offset(-1, -1).Resize(3, 3)
                If cel3.Value <> "" And cel3.Address <> cel2.Address And cel3.Address <> cel.Address Then
                    Dico3L(cel3.Value & cel2.Value & cel.Value) = ""
                End If
            Next cel3
        End If
    Next cel2
Next cel
With Sheets("Feuil3")
    Liste() = .Range("A1:A" & .Range("A" & Rows.Count).End(xlUp).Row).Value
    For i = LBound(Liste) To UBound(Liste)
        If Dico3L.Exists(Left(Liste(i, 1), 3)) Then DicoReduit(Liste(i, 1)) = ""
    Next i
    .[B1].Resize(DicoReduit.Count) = Application.Transpose(DicoReduit.keys)
End With
MsgBox Timer - t
End Sub

L'utilisation du dictionary est ici très intéressante car :
- élimination des doublons dans Dico3L(cel3.Value & cel2.Value & cel.Value) = ""
[ce qui fait que si j'ai, dans ma grille : N O N, il ne me comptera qu'une fois NON; cela permet de réduire la boucle suivante]
- La méthode exists est très rapide pour la comparaison. Plus rapide que l'Application.Match avec une variable tableau. De plus, elle évite la double boucle...
Commenter la réponse de ucfoutu
Messages postés
18039
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
214
0
Merci
voici où j'en suis de mon code "brut" :
sur une feuille d'un nouveau classeur :
un bouton de commande Commanbutton1 et ce code :
Option Explicit
Private grille As Range
Const nom_de_mon_dico As String = "dico3.txt" ' ===>> nom SEUL du fichier texte "dictionnaire"
Const dossier_de_mon_dico As String = "d:\pijaku" ' =====>> chemin du dossier contenant le dico (sans \ final)
Const feuille_affichage As String = "Feuil3" ' ===>> nom de la feuille où afficher le résultat "réduit"
Const col_affichage As String = "A" ' ====>> colonne où afficher le résultat
Const ou_commencer_affichage As Integer = 1 '===> N° de la ligne où commencer l'affichage
Const affiche_nom_champs As Boolean = True ' ===>> True pour afficher les noms de champs en en-tête, False sinon
Const LA As String * 26 = "ABCDEFGHIJKLMNOPQRSTUV"
Private strCon As String



Private Sub CommandButton1_Click()
Dim cubes As Variant, Cel As Range, cpt As Byte, carac As Byte, filtre As String
Dim sep As String, lettres_absentes As String, deb As Double, requete As String, indesirables
Randomize Timer
lettres_absentes = LA

If grille Is Nothing Then ' pas la peine de les réinitialser si déjà fait
Set grille = Range("j11:M14")
End If
Application.ScreenUpdating = False
cpt = 0
cubes = Array("ETUKNO", "EVGTIN", "IELRUW", "DECAMP", "EHIFSE", "RECALS", "ENTDOS", "OFXRIA", "NAVEDZ", "EIOATA", "GLENYU", "BMAQJO", "TLIBRA", "SPULTE", "AIMSOR", "ENHRIS")
touille_cubes cubes '================> voir cette proc plus bas
grille.ClearContents
For Each Cel In grille
Cel.Value = Mid(cubes(cpt), CInt((5 * Rnd()) + 1), 1)
lettres_absentes = Replace(lettres_absentes, Cel.Value, "")
cpt = cpt + 1
Next Cel
Application.ScreenUpdating = True
indesirables = Split(StrConv(lettres_absentes, vbUnicode), Chr(0))
Worksheets(feuille_affichage).Range(col_affichage & ":" & col_affichage).ClearContents
Application.ScreenUpdating = False
deb = Timer
sep = ""
For cpt = 0 To UBound(indesirables) - 1
If cpt > 0 Then sep = ","
filtre = filtre & sep & indesirables(cpt)
Next
filtre = "%[" & filtre & "]%"
requete = "SELECT mot FROM " & nom_de_mon_dico & " WHERE mot not like '" & filtre & "'"
ext_don requete
'msgbox timer - DEB

eclate_par_lettre Worksheets(feuille_affichage)
Application.ScreenUpdating = True
MsgBox " en " & Timer - deb & " seconde(s)"
End Sub

Private Sub touille_cubes(ByRef cubes)
Dim i As Integer, nb As Integer, ou As Integer, temp As String
nb = UBound(cubes)
For i = 0 To nb / 2
ou = Int(((15 - i) * Rnd))
temp = cubes(ou)
cubes(ou) = cubes(nb - i)
cubes(nb - i) = temp
Next
End Sub
Sub ext_don(requete As String)
Dim cible As Range
Set cible = Worksheets(feuille_affichage).Range(col_affichage & ou_commencer_affichage)
Dim connex As ADODB.Connection, jeu_enr As ADODB.Recordset, i As Integer, jeu_enr1 As ADODB.Recordset
If cible Is Nothing Then Exit Sub
Set connex = New ADODB.Connection
On Error Resume Next
connex.Open "Driver={Microsoft Text Driver (*.txt; *.csv)};" & "Dbq=" & dossier_de_mon_dico & ";" & "Extensions=asc,csv,tab,txt;"
On Error GoTo 0
If connex.State <> adStateOpen Then Exit Sub
Set jeu_enr = New ADODB.Recordset
On Error Resume Next
jeu_enr.Open requete, connex, adOpenForwardOnly, adLockReadOnly, adCmdText
On Error GoTo 0
If jeu_enr.State <> adStateOpen Then
connex.Close
Set connex = Nothing
Exit Sub
End If
If affiche_nom_champs Then
For i = 0 To jeu_enr.Fields.Count - 1
cible.Offset(0, i).Formula = jeu_enr.Fields(i).Name
Next i
cible.Offset(1, 0).CopyFromRecordset jeu_enr
End If
cible.CopyFromRecordset jeu_enr
jeu_enr.Close
Set jeu_enr = Nothing
connex.Close
Set connex = Nothing
End Sub



Private Sub eclate_par_lettre(affiche As Worksheet)
'deb = Timer
Dim DL As Long, i As Long, lettre As String, cpt As Long, tablo, temp
With affiche
DL = .Range(col_affichage & Rows.Count).End(xlUp).Row
tablo = .Range(col_affichage & ou_commencer_affichage & ":" & col_affichage & DL)
.Cells.ClearContents
ReDim temp(1 To DL, 1 To 2)
temp(1, 1) = "coucou"
lettre = Mid(tablo(2, 1), 1, 1)
cpt = 1
For i = 2 To DL
Do While Mid(tablo(i, 1), 1, 1) = lettre
temp(cpt, 1) = tablo(i, 1)
cpt = cpt + 1
If i = DL Then Exit Do
i = i + 1
Loop
affiche.Range(lettre & "1:" & lettre & DL) = temp
ReDim temp(1 To DL, 1 To 2)
lettre = Mid(tablo(i, 1), 1, 1)
temp(1, 1) = tablo(i, 1)
cpt = 2
Next
End With
'MsgBox Timer - deb
Erase temp
End Sub
Ne pas oublier :
1) de cocher la référence nécessaire (comme auparavant)
2) d'ajuster les constantes comme vous le souhaitez
3) d'utiliser le dico.text mis en forme comme dit plus haut.


Whismeril
Messages postés
13958
Date d'inscription
mardi 11 mars 2003
Statut
Contributeur
Dernière intervention
13 novembre 2019
319 -
Ok demain!
Bonne soirée
pijaku
Messages postés
12253
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
19 juillet 2019
7 -
J'ai testé ces codes. Parfait. Ton code d'éclatement est sensiblement plus rapide que celui que j'avais écrit, donc je le garde...

J'ai testé également en ajoutant ceci :
Sub TroisLettres()
Dim cel As Range, cel2 As Range, cel3 As Range, Dico3L As Object, Liste(), DicoReduit As Object, i As Long, cpt As Long

cptResult = 0 'A ce stade, nous n'avons pas encore de résultat.
Set Dico3L = CreateObject("Scripting.Dictionary")
Set DicoReduit = CreateObject("Scripting.Dictionary")
For Each cel In Range("Grille")
    For Each cel2 In cel.Offset(-1, -1).Resize(3, 3)
        If cel2.Value <> "" And cel2.Address <> cel.Address Then
            For Each cel3 In cel2.Offset(-1, -1).Resize(3, 3)
                If cel3.Value <> "" And cel3.Address <> cel2.Address And cel3.Address <> cel.Address Then
                    Dico3L(cel3.Value & cel2.Value & cel.Value) = ""
                End If
            Next cel3
        End If
    Next cel2
Next cel
With Sheets("Feuil3")
    Liste() = .Range("A1:A" & .Range("A" & Rows.Count).End(xlUp).Row).Value
    For i = LBound(Liste) To UBound(Liste)
        If Dico3L.Exists(Left(Liste(i, 1), 3)) Then
            If Len(Liste(i, 1)) = 3 Then 'stockage des solutions de 3 lettres
                ReDim Preserve Solutions(cptResult)
                Solutions(cptResult) = Liste(i, 1)
                cptResult = cptResult + 1
            Else                         'sinon "réduction" de la liste des mots
                DicoReduit(Liste(i, 1)) = ""
            End If
        End If
    Next i
    .Columns(col_affichage).ClearContents
    .Range(col_affichage & 1).Resize(DicoReduit.Count) = Application.Transpose(DicoReduit.keys)
End With
End Sub

Solutions et cptResult sont déclarées en tête de Module, comme ceci :
Private Solutions() As String
Private cptResult As Long

et en appelant cette nouvelle procédure depuis le CommandButton1, comme ceci :
Private Sub CommandButton1_Click()
 'Blablabla
  'Appel des trois procédures permettant d'établir la liste des mots, par colonne en feuille d'affichage
  'recherche dans le dictionnaire txt, avec une requête de filtre
  ext_don requete
  'tri du résultat en fonction de tous les chemins de 3 lettres possibles dans la grille
  Call TroisLettres
  'répartition, par ordre alphabétique, de la liste triée, en 26 colonnes
  eclate_par_lettre Worksheets(feuille_affichage)
   Application.ScreenUpdating = True
  MsgBox " en " & Timer - deb & " seconde(s)"
End Sub


Résultat : selon les tirages, cela permet de gagner du temps ou d'en perdre ... un peu.
Mais la perte de ce temps (minime, inférieure à 0,5 sec), est compensée par le fait que nous n'avons plus de mot de 3 lettres dans nos listes, les "gagnants" étant déjà dans les solutions...
Commenter la réponse de ucfoutu
Messages postés
18039
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
214
0
Merci
A Whismeril qui a développé cela de son côté sous C# ;
juste une question : il me semble que C# t'offre la possibilité de lancer des opérations sur plusieurs fils (multithreading). T'est-il venu à l'idée que tu pourrais utiliser cette fonctionnalité (lancement , par exemple, sur un fil fil1 d'une recherche/chemin commençant à telle case de la grille et sur un fil fil2 d'une recherche/chemin commençant à une autre case) ?
Whismeril
Messages postés
13958
Date d'inscription
mardi 11 mars 2003
Statut
Contributeur
Dernière intervention
13 novembre 2019
319 -
pijaku
Messages postés
12253
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
19 juillet 2019
7 -
Salut Whismeril,

Joli boulot.
Une petite erreur subsiste dans la mise en forme de ton tuto du paragraphe : Linq ou pas?

J'ai constaté <gras>sur ma machine>, que

L'a pas fermé la balise gras...
Je te laisse faire la modif.

Bravo en tout cas.
Whismeril
Messages postés
13958
Date d'inscription
mardi 11 mars 2003
Statut
Contributeur
Dernière intervention
13 novembre 2019
319 -
Rhooo j'ai relu pourtant.......
pijaku
Messages postés
12253
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
19 juillet 2019
7 -
après l'apéro ou avant?
Whismeril
Messages postés
13958
Date d'inscription
mardi 11 mars 2003
Statut
Contributeur
Dernière intervention
13 novembre 2019
319 -
Avant hélas 😖
Commenter la réponse de ucfoutu
Messages postés
18039
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
214
0
Merci
Par ailleurs, quel est le tableau dynamique le plus facile/simple à traiter des deux tableaux qui seraient issus : l'un de la grille "normale" de gauche et l'autre d'une grille "étendue" (à droite, ou les " sont des cases vides) ?
La réponse est presque dans la question, que l'on "pense" itérations ou que l'on pense récursivité (clin d'oeil)


" " " " " "
O E N Y " O E N Y "
O L T R " O L T R "
E S A A " E S A A "
F T V R " F T V R "
" " " " " "


________________________
Réponse exacte ? => "REPONSE ACCEPTEE" facilitera les recherches.
Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement répéter son contenu. Je n'interviend
pijaku
Messages postés
12253
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
19 juillet 2019
7 -
Salut,

Comme cela, à première vue, je dirais la grille "normale".
Mais si tu poses la question, il doit y avoir un piège...
Donc, je ne sais pas.
Par ailleurs, je suis complètement paumé dans le code de la recherche...
Je ne trouve absolument rien et n'arrive pas à me focaliser sur un algo simple... J'en rajoute toujours ce qui fait que mes différents codes plantent...
ucfoutu
Messages postés
18039
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
214 -
La grille "étendue" permet de ne pas avoir à décider des articles à parcourir en fonction de la position de celui de départ (ou à gérer une erreur en cas de "débordement").. Si tu parcours, de x2,y2 à x5,y5 à l'intérieur de x1,y1 / x6,y6, tu auras toujours, quelle que soit la position de départ, à parcourir de xn-1,Yn-1 à xn+1,yn+1 et il te suffira alors d'ignorer lorsque = "" ou = xn,yn
pijaku
Messages postés
12253
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
19 juillet 2019
7 -
Ok.
Alors, pour cela, j'avais étudié la possibilité de se passer du test si cellule vide.
Pour cela, j'ai "bricolé" ces différents codes :
Dans le Module Workbook_Open :
Option Explicit

Private Sub Workbook_Open()
Initialisation 'cf Module Procédures
End Sub


Dans un Module Standard :
Option Explicit

Public CelVoisines(15) As String
Public rngCellules(15) As Range
'Utilité : Stockage, dans deux variables tableaux déclarées As Range :
    'rngCellules(15) = Objets Range de chacune des cellules composant la grille
    'CelVoisines(15) = Strings composés des adresses des cellules voisines ET non vides de chaque rngCellules

'A appeler depuis le Workbook_Open() :
Sub Initialisation()
Dim rngCel As Range, rngAdja As Range, i As Byte

Erase CelVoisines
Erase rngCellules
i = 0
For Each rngCel In Range(StrGrille)
    Set rngCellules(i) = rngCel
    For Each rngAdja In rngCellules(i).Offset(-1, -1).Resize(3, 3)
        If rngAdja.Value <> "" And rngAdja <> rngCellules(i).Address Then CelVoisines(i) = CelVoisines(i) & ";" & rngAdja.Address
    Next rngAdja
    CelVoisines(i) = Right(CelVoisines(i), Len(CelVoisines(i)) - 1)
    i = i + 1
Next rngCel
End Sub

'test pour utilisation dans boucle (récursive ou non)
Sub essai()
Dim cellu As String, rngPosition As Range
cellu = Split(CelVoisines(3), ";")(4)
Set rngPosition = Sheets("Feuil1").Range(cellu)
End Sub
ucfoutu
Messages postés
18039
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
214 -
Attends que je digère mes apéros, d'une part, et que j'en finisse avec une partie de pêche à la plie, d'autre part, et je viens te montrer comment (ce ne sera que le début, hein ...) on peut parcourir toutes les cases de la grille, en suivant tout chemin "règlementaire" (diagonal, horizontal, vertical) et sans jamais repasser par une case déjà passée. Cet exemple conduira, sans utiliser à ce stade les contrôles de mot; à un mot constitué de toutes les lettres de la grille.
pijaku
Messages postés
12253
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
19 juillet 2019
7 -
Termine tranquillement ta partie de pêche et l'apéral qui va avec, je continues d'explorer des pistes de mon côté.
Merci
Commenter la réponse de ucfoutu
Messages postés
18039
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
214
0
Merci
Faut pas trop t'inquiéter, pijaku, de mon retard silencieux.
C'est juste que j'ai fait l'imbécile avec des vapeurs de paraffine mal calculées et qui ont explosé ===>> J'ai pour l'instant des difficultés à utiliser la souris (moins à utiliser le clavier) avec ma main et mon poignet droits ...
Je suis donc obligé d'avancer lentement (mais très sûrement).
Il résulte de mes travaux que l'utilisation d'un mécanisme récursif n'est pas la meilleure sous VBA. Il faut, sous VBA, lui privilégier l'itération (à 16 niveaux (et j'en suis au niveau 5)) si l'on veut s'assurer de parcourir vraiment la totalité des chemins possibles sans trop ralentir la procédure.
A bientôt :

PS : Il m'est (mais c'est là un aspect accessoire) venu cette nuit à l'idée qu'il ne serait absolument pas idiot de déterminer (dans le dico réduit/éclaté) la longueur du mot le plus long accepté en commençant par une lettre déterminée. Pourquoi ? ===>> parce qu'une fois atteinte cette limité, inutile de chercher du "plus long possible" puisque "pas de plus long possible" (===>> gain de temps sur les boucles). Mais je reviendrai plus tard sur cet aspect-là.
A bientôt.


________________________
Réponse exacte ? => "REPONSE ACCEPTEE" facilitera les recherches.
Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement répéter son contenu. Je n'interviend
Whismeril
Messages postés
13958
Date d'inscription
mardi 11 mars 2003
Statut
Contributeur
Dernière intervention
13 novembre 2019
319 -
Bonsoir,
commence par bien te soigner c'est le plus important.

parce qu'une fois atteinte cette limité, inutile de chercher du "plus long possible"
oui c'est sûr.
Pour ma part, je réduis le dico à chaque recursion et j'arrête quand il est vide, ça fait beaucoup, beaucoup moins de chemins parcourus!
ucfoutu
Messages postés
18039
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
214 -
Bonsoit, Whismeril,
Ce que tu dis là n'est pas sans m'inquiéter. Tu réduis le dico comment, quand et de quoi, très précisément ?
Whismeril
Messages postés
13958
Date d'inscription
mardi 11 mars 2003
Statut
Contributeur
Dernière intervention
13 novembre 2019
319 -
Et bien, tu d'abord, sur ton conseil j'enlève tous les mots ayant au moins une lettre non tirée, en utilisant une requête avec une expression régulière (pas de like en C#).
En suite je pars d'une lettre, réduit le dico aux mots restants commençant par cette lettre, s'il est vide je passe à la lettre d'après.
S"il n'est pas vide, je prends une lettre adjacente, réduits le dico aux mots restants commençants par les deux lettres, s'il est vide je passe à l'adjacente suivante, s'il n'y en a plus je remonte d'un étage dans ma recherche.
S'il reste des mots, je prends une lettre adjacente à la deuxième lettre et......
pijaku
Messages postés
12253
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
19 juillet 2019
7 -
Salut,

Oui soignes toi!
Rien n'est urgent ici. Nous sommes là pour nous détendre...

On verra ça plus tard.
Tant qu'il te reste tes mains pour pêcher et pour l'apéro...

Allez
Bon dimanche
Commenter la réponse de ucfoutu
Messages postés
18039
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
214
0
Merci
A Whismeril. J'ai bien compris ton mécanisme. Il est astucieux, mais t'impose alors de travailler sur un clone de dico/lettre, remis "au complet" à chaque nouveau départ de chemin. Sinon (et à moins que quelque-chose ne m'échappe) on va rater des mots.
Je m'explique : regardons la grille suivante

. X
T
D
P E
H R
. P T A
. . E .

Imaginons que l'on commence par le chemin mis en exergue ici ===>> on aboutit au mot PET, qui ne peut aller au-delà sur ce chemin.
Si on supprime du dico à partir de là, on ne trouvera plus :
2 fois le mot PETARD
2 fois le mot PETE
2 fois le mot PETA
également présents dans la grille




Whismeril
Messages postés
13958
Date d'inscription
mardi 11 mars 2003
Statut
Contributeur
Dernière intervention
13 novembre 2019
319 -
Tout à fait.
Je fait même un clone à chaque recursion.
Jeux peux tenter de passer mon code dans un traducteur VB.Net, si tu veux voir a moins que tu ne maitrises C#?
Commenter la réponse de ucfoutu
Messages postés
199
Date d'inscription
mercredi 23 avril 2003
Statut
Contributeur
Dernière intervention
25 mai 2017
2
0
Merci
Bonjour à tous,

J'ai été captivé par ce sujet. Il réunit trois thèmes que j'aime beaucoup (jeu de chiffres et de lettres, VBA & Excel et récursivité).

A la lecture de vos échanges, j'ai ainsi essayé de produire un code sur Excel VBA pour ce jeu.

Mon approche a été de coder le dictionnaire sous forme d'un arbre. Cette création est une peu longue mais on ne le crée qu'une seule fois.

Le fichier est disponible à l'adresse http://cjoint.com/?DBArdKXChc3 si vous pouvez y jeter un coup d'oeil.

Merci d'avance et à plus tard
Whismeril
Messages postés
13958
Date d'inscription
mardi 11 mars 2003
Statut
Contributeur
Dernière intervention
13 novembre 2019
319 -
Je n'ai qu'une version 2002.
Ton fichier n'est pas compatible.

J'essayerai au boulot demain
ucfoutu
Messages postés
18039
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
214 -
A carlvb :
enregistre (enregistrer sous) ton classeur en choisissant à la rubrique "Type de fichier" : "Classeur Excel 97 - 2003 (*.xls)"
Il sera ainsi lu et testable par tous ceux qui possèdent une version Office >= 1997.
ucfoutu
Messages postés
18039
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
214 -
Ah non : tu vas avoir là un problème dû à la limitation du nombre de lignes pour les versions antérieures.
La solution consiste peut-être alors à "dresser" ton arbre non à partir de la colonne A pré-remplie de ta feuille "dico", mais directement depuis un fichier texte dico.txt
carlvb
Messages postés
199
Date d'inscription
mercredi 23 avril 2003
Statut
Contributeur
Dernière intervention
25 mai 2017
2 -
Whismeril, ucfoutu :
Pour l'instant (et à cause de la solution de facilité d'avoir mis le dictionnaire dans le fichier même, je dépasse les 65 000 lignes autorisées sur Excel 2003. Une fois ce problème réglé, je pourrais enregistrer le fichier au format antérieur.
A plus.
Commenter la réponse de carlvb
Messages postés
18039
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
214
0
Merci
Bonjour, carlvb,
Ton idée d'arbre est excellente et payante (la recherche des solutions existantes est d'une vitesse impressionnante).
Deux petites "touches" à y apporter :
1) pour répondre au voeu formulé par pijaku (ne pas alouirdir le classeur). Mettre le dico de base dans un fichier texte et ne le charger qu'à l'ouverture du classeur (facile et vu déjà plus haut)
2) modifier le tirage, pour le rendre vraiment aléatoire, comme vu plus haut (touillage des dés afin qu'ils ne sortent pas toujours dans le même ordre).
Mais ce ne sont là que des détails faciles à régler.
B R A V O
ucfoutu
Messages postés
18039
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
214 -
Non, carlb,
Merci à TOI de t'être joint à nous (et avec cette splendide solution, en plus) !
Je dois te confesser que j'avais également tenté l'utilisation d'un TreeView (pas assez rapide, en effet) et d'un tableau croisé dynamique (bof bof ...) et même (mais pire encore) des itérations avec de faux "noeuds" bâtis sur les "mots avant" (pour reprendre dans les boucles) et les "chemins parcourus" à chaque "faux noeud" (pour éviter de repasser par la même case) ===>>> super lent !!!!
Welcome to the club. Tu y as une TRES grande place largement méritée, ami.
carlvb
Messages postés
199
Date d'inscription
mercredi 23 avril 2003
Statut
Contributeur
Dernière intervention
25 mai 2017
2 -
Bonjour,

Encore merci pour l'accueil amical.

Voici donc le lien pour le version Excel 97-2003 http://cjoint.com/?DBBgtVp4gqF J'espère qu'il n'y aura pas de problème de compatibilité.

Il intègre tes remarques ucfoutu (touillage des cubes et chargement du dictionnaire à partir d'un fichier texte dont le chemin est à spécifier lors de l'ouverture)

Pour le format du fichier dico, il faut un mot par ligne (pas de séparateur de champs type virgule ou tabulation mais uniquement un retour chariot).

Je vais devoir aller bosser donc je n'aurai probablement accès à vos messages qu'en fin de journée.

D'ici là bonne journée.

Amicalement.
ucfoutu
Messages postés
18039
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
214 -
Matinal, hein ....?
J'espère que tu as déjà bu au moins ton café.
Je suis en train de parcourir ton code.
J'y trouve quelques modifs salutaires à y apporter.
Elles ne concernent que des points précis (des particularités de VBA) qui n'enlèvent absolument rien à la qualité de l'ensemble et notamment à celle du magnifique mécanisme de ta pensée.
Acceptes-tu que je t'en parle ici ?
Whismeril
Messages postés
13958
Date d'inscription
mardi 11 mars 2003
Statut
Contributeur
Dernière intervention
13 novembre 2019
319 -
@Carl, tu avais un "." à la fin du lien ce qui en faisait une adresse inconnue. J'ai édité ton message pour corriger ce point.
carlvb
Messages postés
199
Date d'inscription
mercredi 23 avril 2003
Statut
Contributeur
Dernière intervention
25 mai 2017
2 -
A ucfoutu :
Je suis en GMT+3 ce qui explique que je sois un peu matinal.
Bien sur que tu peux en parler, justement c'est l'objectif et je suis sur qu'il y a beaucoup d'amélioration à y apporter.

A :Whismeril : Merci pour la correction.

A plus tard.
Commenter la réponse de ucfoutu
Messages postés
18039
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
214
0
Merci
Bien.
On va y aller pas à pas.
Commençons :
1) de manière générale :
Sous VBA (comme sous VB) , la notation du genre :
Dim toto, titi As Integer
aboutit à ne typer en Integer que titi (toto étant typé en variant par défaut de précision sur le type)
Il est nécessaire, si l'on veut typer de manière précise, d'utiliser la notation :
Dim toto as integer, titi As Integer
Tu as à corriger ces notations un peu partout. Cela agilisera ton projet.

2)
dans la procédure Sub Generer_Tirage()
éviter la boucle :
For i = 1 To 4
For j = 1 To 4
Cells(i, j) = Tirage(i, j)
Next j
Next i
et utiliser à la place et avantageusement le "tout-cuit" VBA/Excel :
Range("A1:D4").Value = Tirage

Il ne serait à ce propos pas maladroit de déclarer (dans la partie déclarations du module de code) une fois pour toutes la grille du jeu et de t'y référer ensuite après l'avoir initialisée (juste après le chargement du dico, par exemple)
genre
dans la partie déclarative :
Public grille_du_jeu As range
et dans ton code (après chargement) :
Set grille_du_jeu = worksheets("tirage"):Range("A1:D4")
tu pourras alors ainsi te référer quand tu le voudras dan,s ton code à cette plage, au lieu de cells(..,..)

3) toutes les variables utilisées l'étant dans ton module .bas "opérations sur dico" (puisque depuis les feuilles tu lances systématiquement des procédures de ce module), il convient d'être plus "avare" en mémoire et de déclarer alors en privé tout ce qui est utilisé (sauf et pour cause, la variable Public grille_du_jeu As range, qui doit être publique si tu la crées ) ===>>>
Private Nombre_Mots As Long
Private Mot, Partie As String
Private Debut, Noeud, Noeud_Actuel As Classe_Noeud
Private Maillon, Solution As Classe_Solution
Private Tirage(1 To 4, 1 To 4) As String
Private Dico_Charge As Boolean
Il convient à ce propos de garder à l'esprot que le défaut de déclaration de portée est Public.
Ainsi : Dim toto as ce_que_tu_veux est interprété comme "Public toto ... etc .."
Je continue cet après-midi.
________________________
Réponse exacte ? => "REPONSE ACCEPTEE" facilitera les recherches.
Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement répéter son contenu. Je n'interviend
Commenter la réponse de ucfoutu
Messages postés
18039
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
214
0
Merci
Suite :
Ouille !
Je m'aperçois (en tests) que la "charge dédiée" en prend un coup derrière les oreilles et ne cesse de grandir, jusqu'à alerte puis paralysie. ===>> soins ===>>
soin 1 :
dans la procédure Construire_Dictionnaire() : mettrre à son tout début :
If Dico_Charge Then Exit Sub
et en toute dernière ligne (avant le end sub) :
Set Noeud_Actuel = Nothing

Soin 2 :
mettre en toute dernière ligne (juste avant End sub) de ta procédure Lister_Solution() :
Set Solution = Nothing

Soin 3 :
En toute dernère ligne (juste avant End Sub) de la procédure Lister_Solution()
mettre :
Erase Pris

Voilà pour aujourd'hui : avec cela, déjà, ma machine ne souffre plus.
Je continuerai ce soir ma "fouille"...

________________________
Réponse exacte ? => "REPONSE ACCEPTEE" facilitera les recherches.
Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement répéter son contenu. Je n'interviend
Commenter la réponse de ucfoutu