[VBA-E]Toutes possibilités dans une matrice

Option Explicit

Dim ListeMots() As String

Sub ProcedurePrincipale()
Dim NumCol As Integer, Wsh As Worksheet

'Wsh = stocke la feuille ou sont situés les mots
Set Wsh = ThisWorkbook.Worksheets("Feuil2")
'NumCol = num de la colonne de la feuille Wsh ou sont stockés les mots
NumCol = 2
'on appelle la procédure qui va lister les mots
    'situés dans la feuille et la colonne indiqués
ListerMots Wsh, NumCol

'on lance la procédure pour retirer les mots "en trop"
RetirerMotsLettresManquantes
End Sub

Sub ListerMots(Sh As Worksheet, Col As Integer)
Dim i&

Erase ListeMots
With Sh
    For i = 0 To .Columns(Col).Find("*", , , , xlByColumns, xlPrevious).Row
        ReDim Preserve ListeMots(i)
        ListeMots(i) = .Cells(i + 2, Col)
    Next
End With
End Sub

Sub RetirerMotsLettresManquantes()
Dim alphabet(25), lettresutilisees(), lettresmanquantes()
Dim ListeMotsTemp() As String, lettr As String, mot As String
Dim i&, j&, k&, test As Boolean
Dim MonDico1 As Object, MonDico2 As Object, c

'---------------------------------------- Listage des lettres manquantes dans la grille
'création d'un alphabet
For i = 0 To 25
    alphabet(i) = Chr(65 + i)
Next
'remplissage d'un tableau contenant toutes les lettres de la grille
lettresutilisees = Range("J2:M5") '-----> A Adapter J2:M5 = Matrice 4x4
'utilisation d'un objet dictionary
    '(possibilité d'utiliser ultérieurement la méthode .exists)
Set MonDico1 = CreateObject("Scripting.Dictionary")
For Each c In lettresutilisees
    MonDico1(c) = ""
Next c
Set MonDico2 = CreateObject("Scripting.Dictionary")
For Each c In alphabet
'Si la lettre de l'alphabet n'existe pas dans mondico1
'alors je la rentre dans mondico2
    If Not MonDico1.exists(c) Then MonDico2(c) = ""
Next c
'remplissage de la variable tableau des lettres manquantes
lettresmanquantes = Application.Transpose(MonDico2.keys)

'--------------------------------- Effacement des mots contenant des lettres manquantes
'ListeMots est une variable tableau dans laquelle on a entré tous les mots
'transfert de cette liste dans une liste temporaire
ListeMotsTemp = ListeMots
'on efface la liste des mots pour ne la remplir que des mots utiles
Erase ListeMots
'Boucle sur tous les mots
For i = 0 To UBound(ListeMotsTemp)
    mot = ListeMotsTemp(i)
    'Boucle Lettres manquantes
    For j = 1 To UBound(lettresmanquantes)
        lettr = lettresmanquantes(j, 1)
        'si le mot ne contient la lettre manquante alors
        If InStr(mot, lettr) = 0 Then
            'boolean true on passe à la lettre suivante
            test = True
        'par contre, si le mot contient une lettre manquante
        Else
            'boolean false
            test = False
            'on sort de la boucle des lettres manquantes
            Exit For
        End If
    Next j
    'si boolean est vrai = si le mot ne contient aucune lettre manquante
    If test Then
        'on l'entre dans la variable tableau ListeMots
        ReDim Preserve ListeMots(k)
        ListeMots(k) = ListeMotsTemp(i)
        k = k + 1
    End If
Next i
'[J7].Resize(UBound(ListeMots)) = Application.Transpose(ListeMots)
End Sub

Sub trois_lettres() 
Dim Plage, Plage2, matrice As Range As Range 

Set matrice = Range("D4:G7") ' A ADAPTER 

For Each cell In matrice 
    Set Plage = Range(cell.Offset(-1, -1), cell.Offset(1, 1)) 
     
    For Each cell2 In Plage 
        If cell2 <> "" Then 
            Set Plage2 = Range(cell2.Offset(-1, -1), cell2.Offset(1, 1)) 
                 
                For Each cell3 In Plage2 
                    If cell3 <> "" Then 
                        MsgBox cell & cell2 & cell3 
                    End If 
                Next 
        End If 
    Next 
Next 

End Sub