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

Bonjour a vous tous, A la demande de Pijaku, j'ai donc fait des test sur deux versions et cela donne les resultats suivants: Test sous W8, Intel core I5--3210M 2.5GHz: peu importe la version excel, resultats sensiblement identiques et seulement 32% occupation processeur boggle-like_v0.43test.xls XL 2007 - Charger dico : 3.38 s - Détruire : 174.80 s XL 2010 - Charger dico : 3.16 s - Détruire : 173.30 s XL 2013 - Charger dico : 3.45 s - Détruire : 177.66 s boggle-like_v0.43_v2_test.xls XL 2007 - Charger dico : 3.41 s - Détruire : 177.19 s XL 2010 - Charger dico : 3.20 s - Détruire : 176.68 s XL 2013 - Charger dico : 3.31 s - Détruire : 178.71 s A+

Visual Basic - VBA Excel - Récursivité - Jeu du Boggle

Réponse 21 / 71

ucfoutu Messages postés 18038 Date d'inscription lundi 7 décembre 2009 Statut Modérateur Dernière intervention 11 avril 2018 211
14 févr. 2014 à 19:22

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 18038 Date d'inscription lundi 7 décembre 2009 Statut Modérateur Dernière intervention 11 avril 2018 211
14 févr. 2014 à 20:23

Non !
Ce que j'ai dit plus haut n'est pas malin, dans la mesure où les autres (ceux qui n'auraient ni le dico, ni le classeur, ne pourraient suivre !
On va donc procéder en deux étapes :
étape 1 : faire votre moulinette pour arriver à un fichier .txt, nommé dico3.txt et revêtant cet aspect :

ABAISSA
ABAISSABLE
ABAISSABLES
ABAISSAI
ABAISSAIENT
ABAISSAIS
ABAISSAIT
ABAISSAMES
ABAISSANT
ABAISSANTE
ABAISSANTES
ABAISSANTS
etc...

Si vous voulez éviter de faire cette moulinette (facile) pour y parvenir, je vous la donne ...
Le transformer ensuite en y ajoutant une ligne (par le bloc-notes, par exemple) pour avoir ceci :

mot
ABAISSA
ABAISSABLE
ABAISSABLES
ABAISSAI
ABAISSAIENT
ABAISSAIS
ABAISSAIT
ABAISSAMES
ABAISSANT
ABAISSANTE
ABAISSANTES
ABAISSANTS
etc ...

Observer la ligne ajoutée (elle dit "mot").
Je continue lorsque vous m'aurez fait savoir que vous êtes maintenant prêts, ce fichier texte ayant ainsi été constitué.

ucfoutu Messages postés 18038 Date d'inscription lundi 7 décembre 2009 Statut Modérateur Dernière intervention 11 avril 2018 211
Modifié par ucfoutu le 14/02/2014 à 23:54

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 19028 Date d'inscription mardi 11 mars 2003 Statut Non membre Dernière intervention 24 avril 2024 656
15 févr. 2014 à 08:03

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 18038 Date d'inscription lundi 7 décembre 2009 Statut Modérateur Dernière intervention 11 avril 2018 211
Modifié par ucfoutu le 15/02/2014 à 08:27

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 19028 Date d'inscription mardi 11 mars 2003 Statut Non membre Dernière intervention 24 avril 2024 656
15 févr. 2014 à 08:32

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.

Réponse 22 / 71

pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 14
15 févr. 2014 à 09:14

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

ucfoutu Messages postés 18038 Date d'inscription lundi 7 décembre 2009 Statut Modérateur Dernière intervention 11 avril 2018 211
15 févr. 2014 à 10:49

Gaffe : enlève le "\" final à ta variable chemin.
Bon. C'est bien ce que je pensais. ce que j'ai dit dans mon message précédent peut te faire gagner plusieurs secondes, tant au démarrage (on ne chargera même pas le dico à ce stade), qu'à chaque tirage (où on ne chargera que le dico réduit, en moins de 1 seconde (entre 0,5 et 0.8 secondes selon ce que contient la grille).
En d'autres termes :
- aucun chargement de dico à l'ouverture du classeur
- au tirage : chargement, en feuille 3, de la seule liste des mots possibles (liste extrêmement réduite). Ce chargement se faisant, selon la grille tirée, entre 0,5 et 0,8 secondes)
- à partir de là : ton code reste ce qu'il est, sauf que nous n'aurons probablement plus besoin d'épurer la liste (selon des lettres doublons dans le mot) car déjà suffisamment réduite dès le départ.

Je vais voir comment adapter ton code en n'en gardant que la récursivité..

pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 14
Modifié par pijaku le 15/02/2014 à 11:23

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 31791 Date d'inscription samedi 12 mai 2007 Statut Webmaster Dernière intervention 13 février 2022 5
15 févr. 2014 à 12:58

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 15475 Date d'inscription lundi 11 juillet 2005 Statut Modérateur Dernière intervention 23 avril 2024 103
15 févr. 2014 à 14:39

Je plussoie!
Beau travail d'équipe!

Whismeril Messages postés 19028 Date d'inscription mardi 11 mars 2003 Statut Non membre Dernière intervention 24 avril 2024 656
15 févr. 2014 à 19:21

@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?

Réponse 23 / 71

pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 14
15 févr. 2014 à 09:18

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.

Réponse 24 / 71

ucfoutu Messages postés 18038 Date d'inscription lundi 7 décembre 2009 Statut Modérateur Dernière intervention 11 avril 2018 211
Modifié par ucfoutu le 15/02/2014 à 18:24

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 19028 Date d'inscription mardi 11 mars 2003 Statut Non membre Dernière intervention 24 avril 2024 656
Modifié par Whismeril le 15/02/2014 à 18:54

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 19028 Date d'inscription mardi 11 mars 2003 Statut Non membre Dernière intervention 24 avril 2024 656
15 févr. 2014 à 18:59

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 18038 Date d'inscription lundi 7 décembre 2009 Statut Modérateur Dernière intervention 11 avril 2018 211
Modifié par ucfoutu le 15/02/2014 à 20:55

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).

Réponse 25 / 71

ucfoutu Messages postés 18038 Date d'inscription lundi 7 décembre 2009 Statut Modérateur Dernière intervention 11 avril 2018 211
Modifié par ucfoutu le 16/02/2014 à 18:47

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

Réponse 26 / 71

Whismeril Messages postés 19028 Date d'inscription mardi 11 mars 2003 Statut Non membre Dernière intervention 24 avril 2024 656
16 févr. 2014 à 21:36

Bonsoir de nouvelles grilles de test et les deux anciennes mise à jours
https://dl.dropboxusercontent.com/u/29767375/Tirages.zip

Réponse 27 / 71

pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 14
17 févr. 2014 à 08:17

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?

Réponse 28 / 71

ucfoutu Messages postés 18038 Date d'inscription lundi 7 décembre 2009 Statut Modérateur Dernière intervention 11 avril 2018 211
Modifié par ucfoutu le 17/02/2014 à 08:33

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 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 14
17 févr. 2014 à 08:38

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...

Réponse 29 / 71

Whismeril Messages postés 19028 Date d'inscription mardi 11 mars 2003 Statut Non membre Dernière intervention 24 avril 2024 656
17 févr. 2014 à 22:24

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.

pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 14
18 févr. 2014 à 07:59

Salut,

Ce n'est pas tant l'import d'un fichier txt en C# qui est intéressant (quoique pour un débutant ça peut l'être), mais plutôt la création d'un dictionnaire de 320 000 mots, à partir d'un fichier texte (csv ou txt) et son utilisation en C#.
Là, je penses que ça pourrait intéresser davantage, et servir à d'autres développeurs (un dictionnaire tout cuit c'est toujours intéressant...).
Un dictionnaire relativement complet comme celui proposé ici peut avoir bien d'autres utilisations.
Mais c'est toi qui vois.

ucfoutu Messages postés 18038 Date d'inscription lundi 7 décembre 2009 Statut Modérateur Dernière intervention 11 avril 2018 211
Modifié par ucfoutu le 18/02/2014 à 08:35

Bonjour, pijaku,

Je suis entrain d'effectuer des essais de jeus d'enregistrements à partir du jeu retenu et figurant en colonne A de la feuille Feuil3 du test.
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.
Or, pour que ce soit intéressant, il faut pouvoir lui appliquer des résultats de requêtes
Or, à cette fin, il est également nécessaire de s'appuyer sur des noms de champs (ici un seul : le champ mot)
Et donc ? ===>>> important de passer à true cette constante (dans la partie des déclarations) :

Const affiche_nom_champs As Boolean = True

J'avance bien dans mes tests.

pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 14
18 févr. 2014 à 08:37

Bonjour ucfoutu,

C'est curieux, à chaque fois que l'on se penche chacun de son côté sur le même problème, on trouve des solutions différentes.

De mon côté, pour réutiliser le même jeu d'enregistrement (jeu_enr), je me suis penché sur sa méthode Filter. J'avoue ne pas maîtriser, du tout, l'objet recordset, donc ça me prends du temps et hier je me suis un peu égaré. Ce matin, j'ai peut être touché quelque chose.
Je reviens après mes essais.

Note : on pourrait également voir du côté des propriétés Clone et Requery non?

ucfoutu Messages postés 18038 Date d'inscription lundi 7 décembre 2009 Statut Modérateur Dernière intervention 11 avril 2018 211
Modifié par ucfoutu le 18/02/2014 à 08:53

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 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 14
18 févr. 2014 à 08:53

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

Réponse 30 / 71

ucfoutu Messages postés 18038 Date d'inscription lundi 7 décembre 2009 Statut Modérateur Dernière intervention 11 avril 2018 211
Modifié par ucfoutu le 18/02/2014 à 11:44

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

pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 14
Modifié par pijaku le 18/02/2014 à 12:38

J'ai testé une variable tableau avec ce test :

Sub test()
Dim Tb(), Tb_Out(), k As Long, i As Long, t As Single

t = Timer
Tb = Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row).Value
For i = LBound(Tb) To UBound(Tb)
    'Ici la zone ou l'on teste...
    If Len(Tb(i, 1)) >= 4 And Tb(i, 1) Like "*CA*" Then
        ReDim Preserve Tb_Out(k)
        Tb_Out(k) = Tb(i, 1)
        k = k + 1
    End If
Next i
Range("C2") = UBound(Tb) & " - " & UBound(Tb_Out) & " - " & Timer - t
End Sub

Le résultat est :
avec un tableau de départ de 37230 lignes
on obtient un résultat de 3719 lignes
en 0,046875 secondes
Le test ici :

If Len(Tb(i, 1)) >= 4 And Tb(i, 1) Like "*CA*" Then

ne garde que les mots de plus de 4 lettres possédant la chaine "CA"

A voir toutefois jusqu'où peut-on aller dans la complexité de la requête...
Je penses, notamment, à des tests sur le nombre de "E" ou de "A", dans le style :

WHERE Len(mot) - Len(Replace(mot, "E", "")) < 2

A tester

ucfoutu Messages postés 18038 Date d'inscription lundi 7 décembre 2009 Statut Modérateur Dernière intervention 11 avril 2018 211
18 févr. 2014 à 13:11

Là, impossible : une requête ne peut utiliser Replace.
Je ne pourrais y parvenir qu'avec une succession de requêtes assez alourdissantes (et ce ; pour chaque mot) .
Cette réponse, toutefois, est sur la base d'un dictionnaire (fichier texte) d'une seule colonne (champ mot). Si l'on partait par contre d'un dictionnaire plus complet, à 17 colonnes (donc 17 champs : mot nbA,nbB,nbC .... nbZ), la requête serait très simple du genre :
select mot from ... where nbE = 3
qui renverrait tout les mots contenant 3 "E"

pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 14
18 févr. 2014 à 14:23

L'idée est ton idée de départ qui consiste à ne conserver que les mots pouvant être composés avec les lettres de la grille.
Elle est très intéressante en terme d'épuration.
Mais bon, s'il faut choisir, je préfères perdre encore 2-3 secondes en temps d'exécution à l'épuration de la liste plutôt que de devoir "charrier" un dictionnaire de 27 colonnes qui "pèsera" plus de 13 Mo...

Je vais creuser cela.

ucfoutu Messages postés 18038 Date d'inscription lundi 7 décembre 2009 Statut Modérateur Dernière intervention 11 avril 2018 211
18 févr. 2014 à 14:55

Cà, c'est plus que certain : mieux vaut ne perdre que quelques itérations récursives que de perdre beaucoup plus pour chaque mot testé. C'est ce que je disais bien plus haut déjà : lance à partir de ce point ta démarche récursive, dès lors que le dico réduit est beaucoup moins pléthorique.
On peut réduire sans trop payer, comme nous l'avons fait, la liste résiduelle des mots. Ce serait par contre cher payer que de tenter de réduire à nouveau cette liste pour chaque mot testé.

pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 14
18 févr. 2014 à 16:13

Le fait est que, plus notre liste de mots est épurée, plus vite fonctionne la recherche de solutions.

Pour épurer la liste, nous avons donc fait un import du dictionnaire initial des mots dont toutes les lettres figurent dans la grille.
La deuxième piste, évoquée dès le départ par ucfoutu, consiste à comptabiliser lettres par lettres, et enlever de la liste les mots que l'on ne peux pas former.
J'ai donc testé deux possibilités offertes par VBA et Excel :
- un objet dictionary qui compte les occurrences de chaque lettre dans la grille.
- la fonction WorksheetFunction.CountIf appliquée au Range("Grille")

La plus rapide est celle du Dictionary.
Je vous livre néanmoins les deux pour info (et critiques, le cas échéant).
dictionary :

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

t = Timer
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)
    Flag = True
    For j = 1 To Len(Tb(i, 1))
        If Len(Tb(i, 1)) - Len(Replace(Tb(i, 1), Mid(Tb(i, 1), j, 1), "")) > OccurLettres(Mid(Tb(i, 1), j, 1)) Then Flag = False: Exit For
    Next j
    If Flag Then DicoReduit(Tb(i, 1)) = ""
Next i
ListeMots = DicoReduit.Keys
MsgBox Timer - t & " secondes."
End Sub

WorksheetFunction.CountIf

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

t = Timer
Set Feuille = Sheets("Feuil3")
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)
    Flag = True
    For j = 1 To Len(Tb(i, 1))
        If Len(Tb(i, 1)) - Len(Replace(Tb(i, 1), Mid(Tb(i, 1), j, 1), "")) > WorksheetFunction.CountIf(Range("Grille"), (Mid(Tb(i, 1), j, 1))) Then Flag = False: Exit For
    Next j
    If Flag Then DicoReduit(Tb(i, 1)) = ""
Next i
ListeMots = DicoReduit.Keys
MsgBox Timer - t & " secondes."
End Sub

Les résultats obtenus : (3 essais)
Import (2510 mots) en 1,25 sec
Tri_CountIf (1129 mots restants) en : 0,3867188 secondes.
Tri_Dictionary (1129 mots restants) en : 0,0703125 secondes.

Import (3813 mots) en 1,296875 sec
Tri_CountIf (1508 mots restants) en : 0,5898438 secondes.
Tri_Dictionary (1508 mots restants) en : 8,984375E-02 secondes.

Import (23969 mots) en 1,41015625 sec
Tri_CountIf (5001 mots restants) en : 2,609375 secondes.
Tri_Dictionary (5001 mots restants) en : 0,28125 secondes.

Le bon côté des choses : les deux méthodes de tri trouvent le même nombre de mots avec la même grille...
Le moins bon côté : 5001 mots restants c'est pas rien! Pour ma recherche récursive cela prends : 14 secondes pour trouver les 50 mots formables par la grille.

Je vois bien encore une piste pour épurer davantage la grille... Cela consiste à, comme le disais Whismeril au départ, stocker, dans une variable tableau, les 407 possibilités de chemins de 3 lettres. Une fois cette liste établit, on peut la comparer avec notre liste déjà réduite et voir...
Je vais tester ça de suite et vous tiens informés.

Si d'aventures vous trouviez encore un autre moyen...

Réponse 31 / 71

ucfoutu Messages postés 18038 Date d'inscription lundi 7 décembre 2009 Statut Modérateur Dernière intervention 11 avril 2018 211
Modifié par ucfoutu le 19/02/2014 à 11:13

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

ucfoutu Messages postés 18038 Date d'inscription lundi 7 décembre 2009 Statut Modérateur Dernière intervention 11 avril 2018 211
Modifié par ucfoutu le 19/02/2014 à 12:10

Avec ta grille exemple :
le dico réduit contient 97840 mots dont
commençant par D :13656 mots
commençant par R : 13595 mots
commençant par C : 12729 mots
commençant par P : 10669 mots
commençant par E : 10619 mots
commençant par A : 8111 mots
commençant par S : 8030 mots
commençant par T : 6574 mots
commençant par G : 3896 mots
commençant par I : 3123 mots
commençant par H : 2268 mots
commençant par O : 1848 mots
commençant par N : 1723 mots
commençant par Z : 479 mots
commençant par U : 353 mots
commençant par W : 98 mots
commençant par Y : 47 mots
commençant par X : 22 mots

et aucun autre commençant par d'autres lettres que celles-ci.

pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 14
19 févr. 2014 à 13:03

Reste donc, d'une manière ou d'une autre, 97 840 mots à traiter par la fonction de recherche.
Ce qui est beaucoup trop, comme tu le dis : même si le temps d'exécution de cette fonction est de 0,001 seconde pour un mot, par 97000, ça nous fait 97 secondes!
C'est pourquoi je suggérais de réduire cette liste au maximum, ce que tu soulignes également :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.

ucfoutu Messages postés 18038 Date d'inscription lundi 7 décembre 2009 Statut Modérateur Dernière intervention 11 avril 2018 211
19 févr. 2014 à 13:15

Non, pijaku : pas parmi 97840 mots, mais uniquement parmi le nombre de mots commençant par la lettre de la case de la grille choisie comme début d'un chemin . et ce ; 16 fois.
Avec ton exemple de grille : on se trouve confronté à un tableau de 13656 lorsque la case de départ de chemin est "D", mais :
D n'apparaît qu'une seule fois dans la grille
Même remarque pour R, etc ...
On va par contre beaucoup gagner en compensation lorsque la case de départ est un W, un Y, ou un X (par exemple)

Observation : une grille sera d'autant plus complexe à traiter qu'elle contiendra un nombre plus grand de lettres distinctes (15 lettres distinctes, en ce qui concerne ta grille exemple).

pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 14
19 févr. 2014 à 13:18

Ça y est, je commence à comprendre...
Pas simple tout ça...

ucfoutu Messages postés 18038 Date d'inscription lundi 7 décembre 2009 Statut Modérateur Dernière intervention 11 avril 2018 211
Modifié par ucfoutu le 19/02/2014 à 14:43

Ah !
Exemple le plus rapide d'élimination (élimination dès le premier degré/pas d'un chemin)
Tu commences à la case U de ta grille exemple ===>> dans la liste de la colonne U : pas de mot commençant par UH - ni de mot commençant par UG, ni de mot commençant par UD, n'est-ce pas ? ===>> tu abandonnes donc ce chemin-là (commençant par la case U) sans plus attendre et passes à une autre case de départ

Réponse 32 / 71

ucfoutu Messages postés 18038 Date d'inscription lundi 7 décembre 2009 Statut Modérateur Dernière intervention 11 avril 2018 211
19 févr. 2014 à 19:45

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 19028 Date d'inscription mardi 11 mars 2003 Statut Non membre Dernière intervention 24 avril 2024 656
19 févr. 2014 à 19:50

Ok demain!
Bonne soirée

pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 14
20 févr. 2014 à 12:53

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...

Réponse 33 / 71

ucfoutu Messages postés 18038 Date d'inscription lundi 7 décembre 2009 Statut Modérateur Dernière intervention 11 avril 2018 211
20 févr. 2014 à 01:47

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 19028 Date d'inscription mardi 11 mars 2003 Statut Non membre Dernière intervention 24 avril 2024 656
20 févr. 2014 à 07:43

Le multithreading est un domaine que je n'ai pas encore exploré, comme toi je suis autodidacte et ma fois je découvre au fur et à mesure de mes besoins.
Je n'y ai donc pas pensé.
C'est une piste à suivre, je vais y réfléchir.
Il faut cependant de suite anticiper que si je lance 16 thread (un par lettre) je vais me retrouver avec 16 listes de mots à trier pour sortir les doublons.
Au final le gain de temps n'est pas facile à estimer, mais dans l'optique d'un tuto ça peut être un beau défi!

ucfoutu Messages postés 18038 Date d'inscription lundi 7 décembre 2009 Statut Modérateur Dernière intervention 11 avril 2018 211
Modifié par ucfoutu le 20/02/2014 à 08:02

Deux fils devraient suffire à diminuer significativement la durée.
Par exemple : un fil pour les cases "paires" et un pour les cases "impaires".
Tu peux normalement ne demander à l'autre fil que la mise en oeuvre du mécanisme de démarche (récursivité ou itérations) à appliquer aux mêmes données.

PS : lorsque tout aura pu être définitivement arrêté avec VBA/Excel, j'essaierai (je dis bien essayer) de lancer et gérer un autre fil que je créerai depuis VBA/Excel (scabreux dans certains cas, mais non totalement impossible)

Il est à ce propos (mais je ne le mentionne là que pour la petite histoire) à observer que Excel et VBA/Excel travaillent sur deux fils distincts. Ils sont bien évidemment gérés depuis un langage de bas niveau. C'est la raison principale pour laquelle la modification par formule Excel du contenu d'une cellule Excxel ne provoque pas le déclenchement de l'évènement Change de VBA/Excel

Whismeril Messages postés 19028 Date d'inscription mardi 11 mars 2003 Statut Non membre Dernière intervention 24 avril 2024 656
22 févr. 2014 à 17:42

Bonjour, j'ai essayé avec des BackgroundWorker, soit 2 fils, soit 4 fils.
Le gain de temps n'est pas flagrant.
Pour la grille RDIEUIANOSSTSABA, 203 mots dont un de 16 lettres.

Sur plusieurs recherches successives, sans multithreading, le temps moyen est de 0,76 seconde, avec des extrêmes à 0,83 et 0,68.
Sur plusieurs recherches successives, 2 ou 4, le temps moyen est de 0,71 seconde, avec des extrêmes à 0,79 et 0,65.

Je laisse les 3 possibilités dans le code, il suffira de commenter les 2 qu'on ne veut pas utiliser.

Whismeril Messages postés 19028 Date d'inscription mardi 11 mars 2003 Statut Non membre Dernière intervention 24 avril 2024 656
22 févr. 2014 à 18:31

C'est posté
http://codes-sources.commentcamarche.net/source/100423-le-jeu-du-boggle

Je ferais le tuto pour la recherche récursive par la suite.

Whismeril Messages postés 19028 Date d'inscription mardi 11 mars 2003 Statut Non membre Dernière intervention 24 avril 2024 656
23 févr. 2014 à 20:19

Le tuto est posté
http://codes-sources.commentcamarche.net/faq/10790-exemple-de-methode-recursive-la-resolution-d-une-grille-de-boggle

Réponse 34 / 71

ucfoutu Messages postés 18038 Date d'inscription lundi 7 décembre 2009 Statut Modérateur Dernière intervention 11 avril 2018 211
Modifié par ucfoutu le 20/02/2014 à 07:14

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 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 14
21 févr. 2014 à 12:18

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 18038 Date d'inscription lundi 7 décembre 2009 Statut Modérateur Dernière intervention 11 avril 2018 211
Modifié par ucfoutu le 21/02/2014 à 13:07

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 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 14
21 févr. 2014 à 13:30

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 18038 Date d'inscription lundi 7 décembre 2009 Statut Modérateur Dernière intervention 11 avril 2018 211
21 févr. 2014 à 14:50

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 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 14
Modifié par pijaku le 21/02/2014 à 14:52

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

Réponse 35 / 71

ucfoutu Messages postés 18038 Date d'inscription lundi 7 décembre 2009 Statut Modérateur Dernière intervention 11 avril 2018 211
Modifié par ucfoutu le 22/02/2014 à 20:44

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 19028 Date d'inscription mardi 11 mars 2003 Statut Non membre Dernière intervention 24 avril 2024 656
22 févr. 2014 à 20:49

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 18038 Date d'inscription lundi 7 décembre 2009 Statut Modérateur Dernière intervention 11 avril 2018 211
22 févr. 2014 à 21:04

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 19028 Date d'inscription mardi 11 mars 2003 Statut Non membre Dernière intervention 24 avril 2024 656
22 févr. 2014 à 21:44

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 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 14
22 févr. 2014 à 23:30

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

Réponse 36 / 71

ucfoutu Messages postés 18038 Date d'inscription lundi 7 décembre 2009 Statut Modérateur Dernière intervention 11 avril 2018 211
23 févr. 2014 à 05:09

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

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 19028 Date d'inscription mardi 11 mars 2003 Statut Non membre Dernière intervention 24 avril 2024 656
23 févr. 2014 à 09:15

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#?

Réponse 37 / 71

carlvb Messages postés 199 Date d'inscription mercredi 23 avril 2003 Statut Contributeur Dernière intervention 25 mai 2017 11
26 févr. 2014 à 17:53

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 19028 Date d'inscription mardi 11 mars 2003 Statut Non membre Dernière intervention 24 avril 2024 656
26 févr. 2014 à 19:45

Je n'ai qu'une version 2002.
Ton fichier n'est pas compatible.

J'essayerai au boulot demain

ucfoutu Messages postés 18038 Date d'inscription lundi 7 décembre 2009 Statut Modérateur Dernière intervention 11 avril 2018 211
26 févr. 2014 à 20:16

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 18038 Date d'inscription lundi 7 décembre 2009 Statut Modérateur Dernière intervention 11 avril 2018 211
26 févr. 2014 à 20:45

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 11
26 févr. 2014 à 20:47

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.

Réponse 38 / 71

ucfoutu Messages postés 18038 Date d'inscription lundi 7 décembre 2009 Statut Modérateur Dernière intervention 11 avril 2018 211
26 févr. 2014 à 19:21

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

carlvb Messages postés 199 Date d'inscription mercredi 23 avril 2003 Statut Contributeur Dernière intervention 25 mai 2017 11
26 févr. 2014 à 20:44

Bonjour ucfoutu,

Merci beaucoup pour ton encouragement. Au début j'ai utilisé un treeview pour stocker le dico et un tableau croisé dynamique pour le traitement des résultats mais c'était pas assez rapide et cela aboutissait à des problèmes quand je l'ouvre sur une autre machine.

Pour le touillage des dés, effectivement j'ai lu trop rapidement les premiers posts et je pensais que c'était un problème d'initialisation de Randomize. En relisant les posts j'ai compris où se situe le problème et pourrai le régler.

Pour le dico chargé dans le fichier même, c'était une solution de facilité mais qui doit être réparée.

En tout cas c'est vraiment un sujet qui m'intéresse. Merci à vous tous pour l'avoir créé et dynamisé.

ucfoutu Messages postés 18038 Date d'inscription lundi 7 décembre 2009 Statut Modérateur Dernière intervention 11 avril 2018 211
Modifié par ucfoutu le 26/02/2014 à 21:15

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 11
Modifié par Whismeril le 27/02/2014 à 06:54

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 18038 Date d'inscription lundi 7 décembre 2009 Statut Modérateur Dernière intervention 11 avril 2018 211
Modifié par ucfoutu le 27/02/2014 à 06:41

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 19028 Date d'inscription mardi 11 mars 2003 Statut Non membre Dernière intervention 24 avril 2024 656
27 févr. 2014 à 06:55

@Carl, tu avais un "." à la fin du lien ce qui en faisait une adresse inconnue. J'ai édité ton message pour corriger ce point.

Réponse 39 / 71

ucfoutu Messages postés 18038 Date d'inscription lundi 7 décembre 2009 Statut Modérateur Dernière intervention 11 avril 2018 211
Modifié par ucfoutu le 27/02/2014 à 08:07

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

Réponse 40 / 71

ucfoutu Messages postés 18038 Date d'inscription lundi 7 décembre 2009 Statut Modérateur Dernière intervention 11 avril 2018 211
Modifié par ucfoutu le 27/02/2014 à 14:47

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

VBA Excel - Récursivité - Jeu du Boggle

71 réponses

Votre réponse

Discussions similaires