XL 2016 Le Mot Le Plus Long

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