XL 2016 coloration automatique

[halecs93]

Bonjour,

Dans le fichier exemple que je joins, je cherche à colorer uniquement les cellules précédées et suivies immédiatement de cellules déjà colorées.

Bon, un "dessin" vaut souvent mieux qu'une explication bancale

Donc le fichier est joint.

Un grand merci à tout le monde

 

[sylvanu]

Bonjour Halecs,
En PJ un essai avec cette macro :

Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Fin: If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, Range("A1:A1000")) Is Nothing Then ' Plage à adapter
        If Target = "" Then Exit Sub
        Set Cell = Range(Target.Address)
        If Cell.Offset(-1, 0).Interior.Color <> vbWhite And _
            Cell.Offset(1, 0).Interior.Color <> vbWhite Then
                Cell.Interior.Color = vbYellow
        End If
    End If
Fin:
End Sub

La coloration éventuelle se fait quand on entre une valeur dans une cellule de la colonne A.

 

[halecs93]

Bonjour Halecs,
En PJ un essai avec cette macro :

Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Fin: If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, Range("A1:A1000")) Is Nothing Then ' Plage à adapter
        If Target = "" Then Exit Sub
        Set Cell = Range(Target.Address)
        If Cell.Offset(-1, 0).Interior.Color <> vbWhite And _
            Cell.Offset(1, 0).Interior.Color <> vbWhite Then
                Cell.Interior.Color = vbYellow
        End If
    End If
Fin:
End Sub

La coloration éventuelle se fait quand on entre une valeur dans une cellule de la colonne A.

Tout d'abord merci.

Mais en effet, je souhaitais une macro (en module) que je puisse déclencher sans avoir à entrer une valeur dans la cellule pour la colorer. Simplement, une macro qui repère chaque cellule unique encadrées (en haut et en bas) par des cellules colorées. Et dans ce cas là, elle prend la couleur jaune.

 

[sylvanu]

Re,
Alors ceci peut être :

Sub Colore()
    For L = 2 To Range("A65500").End(xlUp).Row
        If Cells(L, "A") <> "" And _
            Cells(L, "A").Offset(-1, 0).Interior.Color <> vbWhite And _
            Cells(L, "A").Offset(1, 0).Interior.Color <> vbWhite Then
                Cells(L, "A").Interior.Color = vbYellow
        End If
    Next L
End Sub

 

[halecs93]

Re,
Alors ceci peut être :

Sub Colore()
    For L = 2 To Range("A65500").End(xlUp).Row
        If Cells(L, "A") <> "" And _
            Cells(L, "A").Offset(-1, 0).Interior.Color <> vbWhite And _
            Cells(L, "A").Offset(1, 0).Interior.Color <> vbWhite Then
                Cells(L, "A").Interior.Color = vbYellow
        End If
    Next L
End Sub

Ca s'en rapproche... mais en fait, je souhaitais que la cellule se colore et inscrive "ttt", mais pas que l'inscription "ttt" permette la colorisation.

En gros, déclencher la macro colore la cellule et y inscrit "ttt"

 

[sylvanu]

Sub Colore()
    For L = 2 To 1000 ' A adapter suivant besoin
        If Cells(L, "A").Interior.Color = vbWhite And _
            Cells(L, "A").Offset(-1, 0).Interior.Color <> vbWhite And _
            Cells(L, "A").Offset(1, 0).Interior.Color <> vbWhite Then
                Cells(L, "A").Interior.Color = vbYellow
                Cells(L, "A") = "TTT"
        End If
    Next L
End Sub

 

[halecs93]

Sub Colore()
    For L = 2 To 1000 ' A adapter suivant besoin
        If Cells(L, "A").Interior.Color = vbWhite And _
            Cells(L, "A").Offset(-1, 0).Interior.Color <> vbWhite And _
            Cells(L, "A").Offset(1, 0).Interior.Color <> vbWhite Then
                Cells(L, "A").Interior.Color = vbYellow
                Cells(L, "A") = "TTT"
        End If
    Next L
End Sub

Bonjour,

C'est tout à fait ce que je souhaitais.

Un grand grand merci.