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