XL 2016 Le Mot Le Plus Long

[halecs93]

Bonjour à tout le monde....

J'ai tenté de créer un fichier "le mot le plus long"....celui-ci doit permettre de trouver les solutions, après un tirage aléatoire", de 8 lettres de trouver le mot le plus long selon un dictionnaire (feuille nommée DICO).... mais c'est à moitié (au quart, au 1eme satisfaisant etc....car ça ne prend pas en compte les conjugaisons etc)

Une autre idée ?

Merci

 

[eriiic]

Bonjour,
cherche un dictionnaire de scrabble, ils ont les pluriels et les conjugaisons.
L'officiel est l'ODS

 

[halecs93]

Bonjour,
cherche un dictionnaire de scrabble, ils ont les pluriels et les conjugaisons.
L'officiel est l'ODS

j ai pu récupérer ODS 8 en format txt. Merci

 

[Rheeem]

Un lien sur les mots leurs fréquences syllabes et pleins d'autres informations

Lexique – Boris New & Christophe Pallier

 

[halecs93]

Un lien sur les mots leurs fréquences syllabes et pleins d'autres informations

Lexique – Boris New & Christophe Pallier

Merci.... mais au final j'ai ajouté le fameux dictionnaire ODS (version 8).....

 

[laurent950]

Bonsoir

Function SupprimerAccents(Texte As String) As String
    Dim Accents As String, SansAccents As String
    Dim i As Long

    Accents = "àâäáãåçèéêëìíîïñòóôöõùúûüýÿœæÀÂÄÁÃÅÇÈÉÊËÌÍÎÏÑÒÓÔÖÕÙÚÛÜÝŸŒÆ"
    SansAccents = "aaaaaaceeeeiiiinooooouuuuyyoeaeAAAAAACEEEEIIIINOOOOOUUUUYYOEAE"

    For i = 1 To Len(Accents)
        Texte = Replace(Texte, Mid(Accents, i, 1), Mid(SansAccents, i, 1))
    Next i

    SupprimerAccents = Texte
End Function

Function MotPossible(Mot As String, Lettres As String) As Boolean
    Dim Temp As String
    Dim i As Long

    Mot = SupprimerAccents(Mot)
    Lettres = SupprimerAccents(Lettres)

    Temp = Lettres

    For i = 1 To Len(Mot)
        If InStr(Temp, Mid(Mot, i, 1)) = 0 Then
            MotPossible = False
            Exit Function
        Else
            Temp = Replace(Temp, Mid(Mot, i, 1), "", , 1)
        End If
    Next i

    MotPossible = True
End Function

Sub TrouverMotPlusLong()

    Dim ws As Worksheet
    Dim cell As Range
    Dim Mot As String
    Dim MeilleurMot As String
    Dim Tirage As String

    Set wsJeu = Worksheets("Feuil1") ' feuille du tirage A1:H1
    Set ws = Worksheets("DICO")  ' feuille du dictionnaire
'
    ' Récupérer les lettres tirées
    For i = 1 To 8
        Tirage = Tirage & wsJeu.Cells(1, i).Value
    Next i

    MeilleurMot = ""

    For Each cell In ws.UsedRange.Cells

        If cell.Value <> "" Then
            Mot = UCase(cell.Value)

            If Len(Mot) <= 8 Then
                If MotPossible(Mot, Tirage) Then
                    If Len(Mot) > Len(MeilleurMot) Then
                        MeilleurMot = Mot
                    End If
                End If
            End If

        End If
    Next cell

    MsgBox "Mot le plus long trouvé : " & MeilleurMot & _
           vbCrLf & "Longueur : " & Len(MeilleurMot)

End Sub

 

[Rheeem]

Selon Gemeni pour accélérer la recherche il faut substituer les lettres par les nombres primaires ,Cela semble bien fonctionner si le but est de test la présence d'une liste de caractères dans n'importe quel ordre et n'importe quelle position:
Avant de lancer le test, j'ai placé la liste des mots et leurs produits primaire dans un fichier texte séparé car le fichier Excel devient volumineux impossible de l’envoyer donc importer le fichier à partir de Données externes et placer-le dans la feuille Dico2 cellule A1.

 

[halecs93]

Selon Gemeni pour accélérer la recherche il faut substituer les lettres par les nombres primaires ,Cela semble bien fonctionner si le but est de test la présence d'une liste de caractères dans n'importe quel ordre et n'importe quelle position:
Avant de lancer le test, j'ai placé la liste des mots et leurs produits primaire dans un fichier texte séparé car le fichier Excel devient volumineux impossible de l’envoyer donc importer le fichier à partir de Données externes et placer-le dans la feuille Dico2 cellule A1.

heu...pas tout compris