VBA Fonction déterminant si un mot peut-être épelé avec une collection de lettres

liminaire

On vous donne une collection de "cubes" alphabétiques. Il y a vingt blocs avec deux lettres sur chaque bloc. Un alphabet complet est garanti entre tous les côtés des blocs.

Les règles sont simples :
  * Une fois qu'une lettre sur un bloc est utilisée, ce bloc ne peut plus être utilisé
  * La fonction doit être insensible à la casse

La collection des blocs:
(B O) (X K) (D Q) (C P) (N A) (G T) (R E) (T G) (Q D) (F S) (J W) (H U) (V I) (A N) (O B) (E R) (F S) (L Y) (P C) (Z M)

Code d'appel

Sub Main_ABC()
Dim Arr, i As Long

    Arr = Array("A", "barque", "WorkBook", "QUILLE", "ABCJEU", "SQUATTEUR", "CONFUSE")
    For i = 0 To 6
        Debug.Print ">>> Peut-on faire le mot " & Arr(i) & " ? => " & ABC(CStr(Arr(i)))
    Next i
End Sub

Code de la fonction

Function ABC(Mot As String) As Boolean
Dim C As New Collection
Dim Nb As Long, N As Long
Dim b As Integer, i As Integer
Const BLOCKS As String = "B,O;X,K;D,Q;C,P;N,A;G,T;R,E;T,G;Q,D;F,S;J,W;H,U;V,I;A,N;O,B;E,R;F,S;L,Y;P,C;Z,M"

    N = Len(BLOCKS) - Len(Replace(BLOCKS, ";", ""))
    For b = 0 To N
        C.Add Split(BLOCKS, ";")(b), Split(BLOCKS, ";")(b) & b
    Next b
    N = C.Count
    Nb = N
    For b = 1 To Len(Mot)
        For i = 1 To Nb
            If i > Nb Then Exit For
            If InStr(C(i), UCase(Mid(Mot, b, 1))) <> 0 Then
                C.Remove (i)
                Nb = Nb - 1
                Exit For
            End If
        Next
    Next b
    ABC = (N = (C.Count + Len(Mot)))
End Function

Résultat

Le résultat s'affiche dans la fenêtre d'exécution. Si celle-ci n'est pas affichée dans votre éditeur VBA, appuyez simultanément sur Ctrl+G.

>>> Peut-on faire le mot A ? => Vrai
>>> Peut-on faire le mot barque ? => Vrai
>>> Peut-on faire le mot WorkBook ? => Faux
>>> Peut-on faire le mot QUILLE ? => Faux
>>> Peut-on faire le mot ABCJEU ? => Vrai
>>> Peut-on faire le mot SQUATTEUR ? => Faux
>>> Peut-on faire le mot CONFUSE ? => Vrai