Colorer un groupement de ligne sur 2

Fermé
goldi - Modifié le 12 août 2019 à 11:22
 goldi - 11 sept. 2019 à 11:50
Bonjour,

Je cherche sur un fichier excel à colorer un groupement de ligne sur 2 (ou bien à alterner 2 couleurs peu m'importe).

Voilà de quoi illustrer ma question :

Je pars de cela :


et je voudrais aboutir à cela de façon automatisée (car il y a beaucoup de lignes dans le fichier) :



Je souhaite par exemple que le groupement de ligne 14 (lignes 33/34) soit rouge puis le groupement 15 (35/36) d'une autre couleur puis le groupement (37/38/39/40/41) soit à nouveau rouge etc ....

Merci à vous si cela vous inspire :)
A voir également:

5 réponses

eriiic Messages postés 24570 Date d'inscription mardi 11 septembre 2007 Statut Contributeur Dernière intervention 23 avril 2024 7 213
Modifié le 12 août 2019 à 11:14
Bonjour,

ça nous inspirerait plus si on savait ce qui détermine un groupement, quelles colonnes colorer, et qu'on avait un fichier en situation (sans données personnelles) pour tester..
cjoint.com et coller ici le lien fourni.
eric

0
Merci pour le retour, j'ai édité et rajouté une image.

Le but est de colorer toute la ligne à chaque fois.
0
cs_Le Pivert Messages postés 7903 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 11 mars 2024 728
Modifié le 12 août 2019 à 13:06
Bonjour;

Voir ceci pour déterminer les cellules fusionnées:

https://www.commentcamarche.net/faq/18089-vba-tester-une-plage-qui-contient-des-cellules-fusionnees

et cela pour les couleurs:

https://www.excel-pratique.com/fr/vba/couleurs.php

voici un exemple à adapter:

Sub ligneAvecMerge()
Dim Lig As Long
Dim Col As Integer
Dim Mot As String
Dim Mg, TB
Dim plage
    'pour l'exemple, la colonne à tester = A a adapter
    Col = 1 '
    Mot = "1" 'remplacer <bold>LeMot</bold> par celui que vous désirez chercher

    For Lig = Cells(65536, Col).End(xlUp).Row To 1 Step -1
        Set Mg = Cells(Lig, Col).MergeArea
        TB = Split(Mg.Address, ":")
       ' If Cells(Lig, TB(0)).Value = Mot Then
           ' Rows(Lig).Delete
       ' End If
    Next Lig
  plage = Replace(Mg.Address, "$A$", "") 'supprime $A$
     Rows(plage).Interior.ColorIndex = 3 ' rouge
  End Sub
'https://www.commentcamarche.net/faq/18089-vba-tester-une-plage-qui-contient-des-cellules-fusionnees
'https://www.excel-pratique.com/fr/vba/couleurs.php


0
goldi3131 Messages postés 13 Date d'inscription lundi 12 août 2019 Statut Membre Dernière intervention 17 mars 2024
13 août 2019 à 10:37
Merci mais je n'ai pas compris la façon d'identifier les cellules. En effet ton lien renvoie à un test qui "consiste à rechercher un mot dans la colonne E et à supprimer la ligne correspondante si le mot est trouvé dans une des cellules de la colonne E."
Je veux pour ma part faire une ligne sur 2.... !?
0
cs_Le Pivert Messages postés 7903 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 11 mars 2024 728
Modifié le 13 août 2019 à 11:10
J'ai mis voici un exemple à adapter:

le code de suppression était en commentaire!

voici un exemple à télécharger:

https://www.cjoint.com/c/IHniRDnPN5Q


et voilà le code:

Sub ligneAvecMerge()
Dim Lig As Long
Dim Col As Integer
Dim Mg
Dim plage
    'pour l'exemple, la colonne à tester = A a adapter
    Col = 1 '
For Lig = Cells(65536, Col).End(xlUp).Row To 1 Step -1
        Set Mg = Cells(Lig, Col).MergeArea
        If Cells(Lig, 1).Value Mod 2 = 0 Then 'nombre pair
   plage = Replace(Mg.Address, "$A$", "") 'supprime $A$
    Rows(plage).Interior.ColorIndex = 23 ' bleu
Else 'nombre impair
   plage = Replace(Mg.Address, "$A$", "") 'supprime $A$
    Rows(plage).Interior.ColorIndex = 6 ' jaune
End If
    Next Lig
 End Sub


@+
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
Pas arrivé mais je vais essayer de trouver autre chose, merci quand même :)
0
cs_Le Pivert Messages postés 7903 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 11 mars 2024 728
5 sept. 2019 à 18:16
Même avec cet exemple!

https://www.cjoint.com/c/IIfqpqAIkNQ

@+ Le Pivert
0
Rha le lien n'est plus dispo /:

Merci encore pour tes efforts !!
0