Colorier une plage avec une macro

Bonjour,

Genre les mots mêlés je voudrais colorier une plage.

Je montre un exemple ( une couleur suffit pour toutes les suites repérées, dans tous les sens H, V, diag montant ,descendant.)

La plage est fixe, mais le nombre de suites en I peut varier. Des cases peuvent être communes à des suites (ici exemple du 1)

merci

Bonsoir,

une solution via une macro. j'ai fait l'hypothèse qu'il ne pouvait pas y avoir 2 fois le même nombre dans une liste de 5.

Sub coloriersuite()
    Dim index(10000, 50, 3) As Integer    ' positions (max 50) des séries uniques (max 10000) données par le dictionnaire 1,sens (V,H,Dgd ou Ddg),  position de départ 2,x et 3,y
    Set Dico = CreateObject("Scripting.Dictionary")    'mise en dictionnaire de toutes les séries de 5 possibles sur base du tableau donné
    dl = Cells(Rows.Count, 1).End(xlUp).Row
    For l = 1 To dl
        For i = 1 To 7
            cle1 = "": sep1 = ""
            cle2 = "": sep2 = ""
            cle3 = "": sep3 = ""
            cle4 = "": sep4 = ""
            For j = 0 To 4
                If i < 4 Then
                    cle1 = cle1 & sep1 & Format(Cells(l, i + j), "00")    ' serie horizontale H
                    sep1 = "-"
                    If l < dl - 4 Then
                        cle2 = cle2 & sep2 & Format(Cells(l + j, i + j), "00")    ' serie diagonale gauche droite Dgd
                        sep2 = "-"
                    End If
                End If
                If l < dl - 4 Then
                    cle3 = cle3 & sep3 & Format(Cells(l + j, i), "00")    ' serie verticale V
                    sep3 = "-"
                    If i > 4 Then
                        cle4 = cle4 & sep4 & Format(Cells(l + j, i - j), "00")    ' serie diagonale droite gauche Ddg
                        sep4 = "-"
                    End If
                End If
            Next j
            If cle1 <> "" Then ' ajout des clés dans le dictionnaire si non nulle
                cle1 = tri(cle1)
                If cle1 <> "" Then
                    If Not Dico.exists(cle1) Then
                        ip = ip + 1
                        Dico.Add cle1, ip
                    Else
                        ip = Dico.Item(cle1)
                    End If
                    index(ip, 0, 0) = index(ip, 0, 0) + 1
                    iip = index(ip, 0, 0)
                    index(ip, iip, 1) = 1    '(1 pour horizontal)
                    index(ip, iip, 2) = l 'position x de départ
                    index(ip, iip, 3) = i ' position y de départ
                End If
            End If
            If cle2 <> "" Then
                cle2 = tri(cle2)
                If cle2 <> "" Then
                    If Not Dico.exists(cle2) Then
                        ip = ip + 1
                        Dico.Add cle2, ip
                    Else
                        ip = Dico.Item(cle2)
                    End If
                    index(ip, 0, 0) = index(ip, 0, 0) + 1
                    iip = index(ip, 0, 0)
                    index(ip, iip, 1) = 2    '2 pour diagonal g-d
                    index(ip, iip, 2) = l
                    index(ip, iip, 3) = i

                End If
            End If
            If cle3 <> "" Then
                cle3 = tri(cle3)
                If cle3 <> "" Then
                    If Not Dico.exists(cle3) Then
                        ip = ip + 1
                        Dico.Add cle3, ip
                    Else
                        ip = Dico.Item(cle3)
                    End If
                    index(ip, 0, 0) = index(ip, 0, 0) + 1
                    iip = index(ip, 0, 0)
                    index(ip, iip, 1) = 3    ' 3 pour vertical
                    index(ip, iip, 2) = l
                    index(ip, iip, 3) = i
                End If
            End If
            If cle4 <> "" Then
                cle4 = tri(cle4)
                If cle4 <> "" Then
                    If Not Dico.exists(cle4) Then
                        ip = ip + 1
                        Dico.Add cle4, ip
                    Else
                        ip = Dico.Item(cle4)
                    End If
                    index(ip, 0, 0) = index(ip, 0, 0) + 1
                    iip = index(ip, 0, 0)
                    index(ip, iip, 1) = 4    '4 pour diagonal d-g
                    index(ip, iip, 2) = l
                    index(ip, iip, 3) = i
                End If
            End If
        Next i
    Next l
    dl = Cells(Rows.Count, "M").End(xlUp).Row
    For i = 1 To dl
        cle = "": sep = ""
        For j = 1 To 5
            cle = cle & sep & Format(Cells(i, j + 8), "00")
            sep = "-"
        Next j
        cle = tri(cle)
        If Dico.exists(cle) Then
            ip = Dico.Item(cle)
            iip = index(ip, 0, 0)
            For k = 1 To iip
                x = index(ip, k, 2)
                y = index(ip, k, 3)
                For j = 0 To 4
                    Select Case index(ip, k, 1)
                    Case 1
                        Cells(x, y + j).Interior.Color = vbGreen
                    Case 2
                        Cells(x + j, y + j).Interior.Color = vbGreen
                    Case 3
                        Cells(x + j, y).Interior.Color = vbGreen
                    Case 4
                        Cells(x + j, y - j).Interior.Color = vbGreen
                    End Select
                Next j
            Next k
        End If
    Next i
End Sub
Function tri(cle)
    Dim a As Variant
    a = Split(cle, "-")
    For i = LBound(a) To UBound(a) - 1
        For j = i + 1 To UBound(a)
            If a(i) = a(j) Then tri = "": Exit Function
            If a(i) > a(j) Then e = a(i): a(i) = a(j): a(j) = e
        Next j
    Next i
    tri = Join(a, "-")
End Function