Você recebe uma coleção de ‘cubos’ alfabéticos. Existem vinte blocos com duas letras em cada bloco. Um alfabeto completo é garantido entre todos os lados dos blocos.
As regras são simples: uma vez que uma letra em um bloco é usada, este bloco não pode mais ser usado; a função deve ser insensível a maiúsculas e minúsculas
A coleção dos blocos:
(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)
Código de chamada
Sub Main_ABC()
Dim Arr, i As Long
Arr = Array("A", "barca", "WorkBook", "QUILHA", "ABCJOGO", "SQUATTER", "CONFUSO")
For i = 0 To 6
Debug.Print ">>> Podemos fazer a palavra "& Arr(i) &"? => " & ABC(CStr(Arr(i)))
Next i
End Sub
Código da função
Function ABC(Palavra 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(Palavra)))
End Function
Resultado
O resultado é exibido na janela de execução. Se não for exibido no seu editor VBA, pressione, simultaneamente, as teclas
Ctrl +
G.
>>> Podemos fazer a palavra A ? => Verdadeiro
>>> Podemos fazer a palavra barca ? => Verdadeiro
>>> Podemos fazer a palavra WorkBook ? => Falso
>>> Podemos fazer a palavra QUILHA ? => Falso
>>> Podemos fazer a palavra ABCJOGO ? => Verdadeiro
>>> Podemos fazer a palavra SQUATTER ? => Falso
>>> Podemos fazer a palavra CONFUSO ? => Verdadeiro
Foto: © Microsoft.