Colorier plusieurs groupes

Bonjour à tous,

J’ai trouvé sur le net un code qui fait le travail mais malheureusement qu’à moitié. Il colorie seulement la première ligne de chaque groupe, or je souhaite l’adapter pour colorier l’ensemble des lignes de chaque groupe.

Comment déterminer mes groupes ?

Je détermine mes groupes de la manière suivante :

On va se baser sur la colonne "A", et pour cela, on va partir de la 2e ligne.

La première cellule de la 1ere ligne de mon 1er groupe est "A2", il est non vide (elle contient le numéro du 1er groupe = groupe 1), pour déterminer la dernière ligne de mon 1er groupe, il faut se dire : tant que les cellules se trouvant en dessous de ma cellule "A2" sont vides, alors, on se trouve toujours dans le 1er groupe.

Lorsqu’on rencontre une cellule non vide, qui contient dans mon cas), le numéro du 2e groupe), cela veut dire qu’on se trouve à la 1ere ligne de notre 2e groupe.

On continue notre manœuvre jusqu’à la dernière ligne de mes données, cette dernière ligne de mon tableau de données se trouve dans la colonne "F".

Le résultat souhaité se trouve dans la feuille "Croissement (2)"

Merci pour vos contributions.

Re,

Juste un petit détail, je souhaite une solution avec vba (SVP) et pas avec MFC. Merci.

Bonjour Harzer, le forum,

A tester:

Sub Colorier_Les_Groupes()
 Dim dl
 ' Ce code colore chaque première ligne de chaque groupe
 ' les couleurs choisient sont toutes des couleurs claires pour permettre
 ' de lire facilement les données malgré les fonds des cellules coloriés

 couleurs = Array(4, 8, 15, 17, 19, 20, 22, 24, 26, 27, 28, 33, 34, 35, 36, 37, 38, 39, 40, 42, 43, 44, 45, 46, , 48, 50)
  With Sheets("Croissement")
   dl = .UsedRange.Rows.Count
   Set mondico = CreateObject("Scripting.Dictionary")

   Application.ScreenUpdating = False

   For Each c In .Range("A2:A" & dl)
    If c <> "" Then mondico.Item(c.Value) = mondico.Item(c.Value) + 1
   Next c

   For Each c In .Range("A2:A" & dl)
    If c <> "" Then nocoul = (Application.Match(c.Value, mondico.keys, 0)) Mod UBound(couleurs)
     c.EntireRow.Resize(, 10).Interior.ColorIndex = couleurs(nocoul)
   Next c
  End With
End Sub

Cordialement,

Bonjour xorsankukai et le Forum,

C’est exactement ce qu’il me fallait, Grand MERCI pour l’adaptation du code existant à mes besoins. Ça fonctionne parfaitement.

Je vous avoue que j’ai jeté un coup d’œil à votre code pour le comprendre mais il y’a des passages ou je ne comprends pas grand-chose, puis-je me permettre de vous demander si vous pouvez mettre quelques commentaires histoire de me faciliter le compréhension du code.

Avec mes remerciements.

Re,

Je ne suis pas un pro non plus,

Voici quelques commentaires (les pros me corrigeront si je dis une ânerie )

Sub Colorier_Les_Groupes()
 Dim dl% '.............déclaration de la variable dl (dernière ligne) en integer
 Dim c As Range  '.....déclaration de c(cellule)
 Dim couleurs  '.......déclaration du tableau couleurs
 Dim dico As Object '..déclare le dictionnaire dico

 ' Ce code colore chaque groupe
 ' les couleurs choisient sont toutes des couleurs claires pour permettre _
   de lire facilement les données malgré les fonds des cellules coloriés

 couleurs = Array(4, 8, 15, 17, 19, 20, 22, 24, 26, 27, 28, 33, 34, 35, 36, _
            37, 38, 39, 40, 42, 43, 44, 45, 46, , 48, 50) 'tableau contenant les couleurs

  With Sheets("Croissement") '.........................agit sur cette feuille uniquement
   dl = .UsedRange.Rows.Count '........................définit la dernière ligne utilisée de la feuille
   Set mondico = CreateObject("Scripting.Dictionary") 'définit le dictionnaire

   Application.ScreenUpdating = False 'désactive le rafraichissment de l'écran

   For Each c In .Range("A2:A" & dl) 'boucle sur chaque cellule de la colonne A (de A2 à la dernière ligne)
    If c <> "" Then mondico.Item(c.Value) = mondico.Item(c.Value) + 1 'si c <> vide, on l'ajoute au dico
   Next c

   For Each c In .Range("A2:A" & dl) 'boucle sur chaque cellule de la colonne a (de A2 à la dernière ligne)
   'si c <>"" ,on cherches la position (parmi les clés du Dico) de chaque valeur de c
    If c <> "" Then nocoul = (Application.Match(c.Value, mondico.keys, 0)) Mod UBound(couleurs)
     c.EntireRow.Resize(, 10).Interior.ColorIndex = couleurs(nocoul) 'on colorie les cellules de la ligne (de A à J)
     'le changement de couleur s'effectuera lorsque la valeur en colonne A changera _
       si vide, on conserve la couleur
   Next c
  End With
End Sub

Bonne continuation,

Bonjour xorsankukai,

Merci pour votre retour avec le code commenté.

Merci beaucoup pour le partage de vos connaissances.

Vous me dites que vous n’êtes pas un pro, je vous répond que j’en connais moins que vous parce que vous êtes venu à mon secours à plusieurs reprises et c’est encore l’occasion pour moi de vous remercier pour votre patience et le temps que vous passez à aider les autres.

Cordiale poignée de mains.

Amicalement.

Rechercher des sujets similaires à "colorier groupes"