XL 2016 coloration automatique

halecs93 · 12 Février 2024

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 · 12 Février 2024

VB:

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

sylvanu · 12 Février 2024

Bonjour Halecs,
En PJ un essai avec cette macro :

VB:

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 · 12 Février 2024

sylvanu à dit:

Bonjour Halecs,
En PJ un essai avec cette macro :

VB:

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 · 12 Février 2024

Re,
Alors ceci peut être :

VB:

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 · 12 Février 2024

sylvanu à dit:

Re,
Alors ceci peut être :

VB:

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 · 12 Février 2024

VB:

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 · 13 Février 2024

sylvanu à dit:

VB:

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.

XL 2016 coloration automatique

halecs93

XLDnaute Impliqué

Pièces jointes

sylvanu

sylvanu

XLDnaute Barbatruc

Pièces jointes

halecs93

XLDnaute Impliqué

sylvanu

XLDnaute Barbatruc

Pièces jointes

halecs93

XLDnaute Impliqué

sylvanu

XLDnaute Barbatruc

Pièces jointes

halecs93

XLDnaute Impliqué

Discussions similaires