Mise en couleur d'un tableau en fonction de la 1er ligne et 1er colonne

jodo · 29 Mai 2016

Je cherche une macro pour automatiser la mise en couleur d'un tableau en fonction des données en entête et sur la 1ere colonne.
Voici mon besoin :
Lorsque sur la ligne A (voir exemple joint) la date (au format personnalisé : AAAAMM) en colonne égale la date en ligne, on met la cellule en gris à l'intersection de la colonne et de la ligne.
S'il y a un nombre (> = 1) on met les cellules en orange jusqu'à à la cellule en gris. (sinon les cellules restent blanche)
S'il y a un nombre après la cellule en gris, on met la cellule en rouge, sinon elle reste verte (même si elles n'ont pas de nombre).
S'il n'y a pas de date en colonne, les cellules contenant un nombre sont en rouge.
Le tableau à un nombre de lignes et de colonnes differents, donc il faut que la mise en forme s'applique que sur les cellules selectionnées. Dans mon fichier il y a plusieurs tableaux (je mets en forme un tableau après l'autre)
J'ai mis un exemple en piece jointe.
Merci pour votre aide

Hieu · 30 Mai 2016

Re : Mise en couleur d'un tableau en fonction de la 1er ligne et 1er colonne

Salut,

regarde si ça te convient

Code:

Sub lkjp()
Range("D6:O9").Interior.Pattern = xlNone
orange = 49407
gris = 12566463
vert = 3407718
rouge = 255

For i = 1 To 4
egal = WorksheetFunction.Match(Range("c5").Offset(i, 0), Range("d5:o5"), 0)
Range("c5").Offset(i, egal).Interior.Color = gris
For j = 1 To egal - 1
    If Range("c5").Offset(i, j) >= 1 Then Range("c5").Offset(i, j).Interior.Color = orange
Next j
For j = egal + 1 To 12
    If Range("c5").Offset(i, j) <> 0 Then
        Range("c5").Offset(i, j).Interior.Color = rouge
    Else
        Range("c5").Offset(i, j).Interior.Color = vert
    End If
Next j
Next i
End Sub

++

jodo · 30 Mai 2016

Re : Mise en couleur d'un tableau en fonction de la 1er ligne et 1er colonne

Bonjour Hieu,

Oui c'est bien mais je voudrais que la macro s'adapte au nombre de ligne et de colonne par ce que mes tableaux sont de tailles différentes. (genre je sélectionne le tableau et la macro travaille sur la zone sélectionnée).

Merci

Hieu · 30 Mai 2016

Re : Mise en couleur d'un tableau en fonction de la 1er ligne et 1er colonne

Yop,

Nouvel essai !!

Code:

Sub lkjp()
orange = 49407
gris = 12566463
vert = 3407718
rouge = 255

Application.ScreenUpdating = False
Set zone = Range(Selection.Address)
Set o = Range(zone(1, 1).Offset(-1, -1).Address)

zone.Interior.Pattern = xlNone
largeur = zone.Columns.Count
hauteur = zone.Rows.Count

For i = 1 To hauteur
    If IsEmpty(o.Offset(i, 0)) Then
        egal = 0
    Else
        egal = WorksheetFunction.Match(o.Offset(i, 0), zone.Rows(1).Offset(-1, 0), 0)
    End If

For j = 1 To largeur
Select Case j
    Case Is < egal
        If o.Offset(i, j) >= 1 Then Range("c5").Offset(i, j).Interior.Color = orange
    Case egal
        o.Offset(i, j).Interior.Color = gris
    Case Else
        If o.Offset(i, j) <> 0 Then
        o.Offset(i, j).Interior.Color = rouge
        Else
        o.Offset(i, j).Interior.Color = vert
        End If
End Select
Next j

Next i
End Sub

Dans l'exemple, il faut sélectionner la zone Range("d69").
Ctrl +k pour lancer la macro

++
Hieu

jodo · 31 Mai 2016

Re : Mise en couleur d'un tableau en fonction de la 1er ligne et 1er colonne

Bonjour Hieu !

Super ! ça marche.

J'ai juste remplacer le range (C5) (petit oublie)
If ffset(i, j) >= 1 Then Range("c5").Offset(i, j).Interior.Color = orange
par :
If ffset(i, j) >= 1 Then ffset(i, j).Interior.Color = orange
et ça fonctionne même si le tableau n'est pas au même endroit.

Encore Merci !

A+

Mise en couleur d'un tableau en fonction de la 1er ligne et 1er colonne

jodo

XLDnaute Nouveau

Pièces jointes

Hieu

XLDnaute Impliqué

Pièces jointes

jodo

XLDnaute Nouveau

Hieu

XLDnaute Impliqué

Pièces jointes

jodo

XLDnaute Nouveau

Discussions similaires