Changement de couleur à chaque changement de référence

Bonjour le forum,

Quelqu'un pourrait-il m'aider avec un petit bout de VBA ?

J'ai régulièrement des tableaux de plusieurs centaines de lignes que j'imprime pour faire réaliser des opérations logistiques à des opérateurs.

Afin de rendre plus lisibles mes tableaux, je souhaiterais à chaque changement de référence (valeur contenue dans la colonne A dans mon exemple), modifier la couleur de fond de la ligne entière (enfin, juste les cellules pour lesquelles il y a un titre en ligne 1) et entourer toutes les lignes d'une même référence avec les bordures extérieures épaisses.

Dans le fichier joint, vous trouverez dans la feuille 1, les données brutes non mises en forme et le résultat souhaité.

Merci d'avance pour votre aide.

Titikio

Bonjour Titikio, bonjour le forum,

Essaie ça :

Sub Macro1()
Dim O As Worksheet 'déclare la variable O (Ongelt)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim TL() As Variant 'déclare la variable TL (Tableau des lignes)
Dim R As String 'déclare la variable R (Référence)
Dim I As Integer 'déclare la variable I (Incrément)
Dim K As Integer 'déclare la variable K (incrément)
Dim C As Byte 'déclare la variable C (Couleur)

Set O = Worksheets("Feuil1") 'définit l'onglet O
TV = O.Range("A1").CurrentRegion 'définit le tableau des valeurs TV
K = 1 'initialise la variable K
ReDim Preserve TL(1 To 2, 1 To K) 'redimensionne le tableau des lignes (2 lignes , K colonnes)
TL(1, K) = 2: R = TV(2, 1) 'récupère dans la ligne 1 de TL la ligne de début de plage K, définit la référence R
For I = 2 To UBound(TV, 1) 'boucle sur toutes les lignes I du tableau des valeur TV (en partant de la seconde)
    If TV(I, 1) <> R Then 'condition : si la donnée en ligne I colonne 1 de TV est différente de R
        TL(2, K) = I - 1 'récupère dans la ligne 2 de TL la ligne de fin de plage K
        K = K + 1 'incrément K
        ReDim Preserve TL(1 To 2, 1 To K) 'redimensionne le tableau des lignes
        TL(1, K) = I 'recupère dans la ligne 1 de TL la ligne de début de la plage K
        R = TV(I, 1) 'redéfinit la référence R
    End If 'fin de la condition
Next I 'prochaine ligne de la boucle
TL(2, K) = Cells(Application.Rows.Count, "A").End(xlUp).Row 'définit la ligne de fin de la dernière plage
'le tableau TL contient la ligne de début et la ligne de fin de chaque plage ayant la même référence

With O.Range("A1").CurrentRegion 'prend en compte le tableau entier
    .Borders(xlEdgeLeft).Weight = xlMedium 'bordure épaisse gauche
    .Borders(xlEdgeTop).Weight = xlMedium 'bordure épaisse haut
    .Borders(xlEdgeBottom).Weight = xlMedium 'bordure épaisse bas
    .Borders(xlEdgeRight).Weight = xlMedium 'bordure épaisse droite
End With 'fin de la prise en compte du tableau entier

O.Cells(1, 1).Resize(1, UBound(TV, 2)).Interior.ColorIndex = 19 'couleur première ligne (à adapter)

For I = 1 To K 'boucle sur toutes les plages différentes
    C = IIf(C = 1, 0, 1) 'définit la couleur C (permet d'alterner une plage sur 2)
    With O.Range(O.Cells(TL(1, I), 1), O.Cells(TL(2, I), 1).Resize(, UBound(TV, 2))) 'prend en compte la plage de la référence
        If C = 0 Then .Interior.ColorIndex = 19 'définit la couleur de la plage
        .Borders(xlEdgeLeft).Weight = xlMedium 'bordure épaisse gauche
        .Borders(xlEdgeTop).Weight = xlMedium 'bordure épaisse haut
        .Borders(xlEdgeBottom).Weight = xlMedium 'bordure épaisse bas
        .Borders(xlEdgeRight).Weight = xlMedium 'bordure épaisse droite
    End With 'fin de la prise en compte de la plage de la référence
Next I 'prochaine plage de la boucle
End Sub

Bonjour ThauTheme,

Merci beaucoup, c'est tout à fait ce dont j'avais besoin.

Et en plus, avec les explications à chaque ligne, c'est top !!

Rechercher des sujets similaires à "changement couleur chaque reference"