Colorier cellule d'un même groupe

gourdin

XLDnaute Impliqué
Bonjour,

Si je sais comment procéder pour colorier une ligne sur 2 d'un tableau via le format conditionnel, en revanche je bute pour colorier 1 "groupe" de cellules sur 2
Voir fichier joint.

Merci
 

Pièces jointes

  • Classeur1.xlsx
    8.1 KB · Affichages: 37

Modeste

XLDnaute Barbatruc
Bonjour gourdin,

Une solution (parmi bien d'autres)...

Attention: sélectionner la plage de cellules concernée au préalable. On verra par la suite, avec plus d'infos comment repérer la plage sans la sélectionner.
Coller dans la fenêtre de code de la Feuil1:

VB:
Sub coul()
With Selection
    For lig = 1 To .Rows.Count
        If .Cells(lig, 1) & .Cells(lig, 2) <> .Cells(lig - 1, 1) & .Cells(lig - 1, 2) Then cpt = cpt + 1
        If cpt Mod 2 = 1 Then .Cells(lig, 1).Resize(1, 3).Interior.ColorIndex = 6
    Next lig
End With
End Sub
 

Paf

XLDnaute Barbatruc
bonjour gourdin, Modeste,

une autre version (sans sélection)

Code:
Sub Gourdin()
Dim i As Long, AColorer As Boolean
AColorer = True
With Worksheets("Feuil1") ' à adapter
For i = 3 To .Range("B" & Rows.Count).End(xlUp).Row
    If AColorer = True Then .Cells(i, 2).Resize(1, 3).Interior.ColorIndex = 6
    If Not (.Cells(i, 2) = .Cells(i + 1, 2) And .Cells(i, 3) = .Cells(i + 1, 3)) Then AColorer = Not AColorer
Next
End With
End Sub

A+
 

gourdin

XLDnaute Impliqué
Bonjour gourdin,

Une solution (parmi bien d'autres)...

Attention: sélectionner la plage de cellules concernée au préalable. On verra par la suite, avec plus d'infos comment repérer la plage sans la sélectionner.
Coller dans la fenêtre de code de la Feuil1:

VB:
Sub coul()
With Selection
    For lig = 1 To .Rows.Count
        If .Cells(lig, 1) & .Cells(lig, 2) <> .Cells(lig - 1, 1) & .Cells(lig - 1, 2) Then cpt = cpt + 1
        If cpt Mod 2 = 1 Then .Cells(lig, 1).Resize(1, 3).Interior.ColorIndex = 6
    Next lig
End With
End Sub

Bonjour Modeste
Merci pour cette solution qui me convient parfaitement (je me débrouille pour sélectionner la plage)
 

gourdin

XLDnaute Impliqué
bonjour gourdin, Modeste,

une autre version (sans sélection)

Code:
Sub Gourdin()
Dim i As Long, AColorer As Boolean
AColorer = True
With Worksheets("Feuil1") ' à adapter
For i = 3 To .Range("B" & Rows.Count).End(xlUp).Row
    If AColorer = True Then .Cells(i, 2).Resize(1, 3).Interior.ColorIndex = 6
    If Not (.Cells(i, 2) = .Cells(i + 1, 2) And .Cells(i, 3) = .Cells(i + 1, 3)) Then AColorer = Not AColorer
Next
End With
End Sub

A+

Merci aussi Paf
Cela me convient également.
 

Modeste

XLDnaute Barbatruc
Re-bonjour,
Salut Paf :), R@chid :) ... et chris :) (qui passait par là),
Mes hommages à tous les autres,

C'est dans le début de ligne suivante que ça se passe (je te laisse chercher un instant ;))
VB:
If cpt Mod 2 = 1

Ce qui suit met la couleur de remplissage transparente avant de ré-appliquer une couleur. Elle repère aussi la fin de plage (au départ de B3) sans qu'une sélection soit nécessaire.
VB:
Sub coul()
With [B3].Resize([B3].CurrentRegion.Rows.Count - 1, [B3].CurrentRegion.Columns.Count)
    .Interior.ColorIndex = xlNone
    For lig = 1 To .Rows.Count
        If .Cells(lig, 1) & .Cells(lig, 2) <> .Cells(lig - 1, 1) & .Cells(lig - 1, 2) Then cpt = cpt + 1
        If cpt Mod 2 = 0 Then .Cells(lig, 1).Resize(1, 3).Interior.ColorIndex = 6
    Next lig
End With
End Sub
 

mapomme

XLDnaute Barbatruc
Supporter XLD
Bonsoir à tous,

Une autre MFC par formule :
VB:
=EST.IMPAIR(SOMME((($B$3:$B3<>$B$2:$B2)+($C$3:$C3<>$C$2:$C2)>0)*LIGNE($B$3:$B3)/LIGNE($B$3:$B3)))

Il y a une petite différence entre le résultat de la formule de r@chid et celle de ma pomme. Voir commentaire dans le fichier.
 

Pièces jointes

  • gourdin-mfc- v1.xlsx
    11.9 KB · Affichages: 26

Discussions similaires

Statistiques des forums

Discussions
312 816
Messages
2 092 361
Membres
105 378
dernier inscrit
y07