XL 2010 changement de couleur de police de cellules d'un tableau en fonction de leur ordre chronologique

sebbbbb

XLDnaute Occasionnel
Bonjour a tous

je viens à nouveau faire appel à vos connaissances

pour mon travail, j'ai régulièrement des relèves équipage à gérer. pour cela j'utilise un tableau (voir PJ) qui coupé en 2 parties

1) les arrivants
2) les débarquants

j'entre au fur et à mesure des infos collectés le nom et differentes info concernant toutes ces personnes. ensuite grace à une macro, un ordre chronologique est effectué dans chaque partie du tableau pour avoir :
1) les arrivants classés par ordre croissant en fonction de la date et l'heure d'arrivée de leur avion (colonne N20 & P20 pour la 1ere partie du tableau)
2) les débarquants classés par ordre croissant en fonction de la date et heure de débarquement (colonne N34 & P34 pour la 2e partie du tableau)

dans l'exemple en PJ j'ai déjà fait fonctionner la macro pour avoir cet ordre chronologique (en cliquant sur le bouton tri)

Ce que je souhaiterai c'est que, pour une meilleure visibilité, certaines cellules aient une couleur de police identique en fonction :
1) dans la 1ere partie du tableau : toutes les personnes ayant une date et un horaire d'arrivée identique (colonne N20 & P20)
2) dans le 2eme partie du tableau : toutes les personnes ayant une date et un horaire de débarquement identique (colonne N34 & P34)

Donc maxi 10 couleurs différentes par tableau car 10 lignes dans chaque

autres contraintes : je souhaiterai que toutes les dates et horaires de la selection (T21:U30) ainsi que (W35:X44) restent tout le temps en rouge (comme dans l'example)

en 2e PJ vous trouverez ce à quoi j'aspire (mais automatiquement bien sur)

merci par avance pour votre aide

Seb
 

Fichiers joints

Laurent78

XLDnaute Occasionnel
Bonsoir Seb,
Attention, je n'ai pas tout fait !
l'idée :
dans AH21:AH30 j'ai fait une petite formule qui regarde si la date de la ligne courante est égale à la date de la ligne précédente. Si c'est la cas, je conserve le même ID, sinon, j'ajoute 1 à l'ID.
Ensuite, sur la plage des dates N21:p30, à l'aide de la mise en forme conditionnelle, j'applique une couleur différente en fonction de la valeur de la colonne AH (ATTENTION, je n'ai fait que 5 règles, il en faut 10).
Bien sûr, cela ne peut fonctionner que parce que les date+heure(s) sont triées. Dans le cas contraire, il faudrait utiliser la fonction EQUIV en AH.

Par contre je n'ai pas compris la deuxième contrainte, il suffit de mettre le cellules en rouge, non ?
Bonne soirée,
Laurent
 

Fichiers joints

job75

XLDnaute Barbatruc
Pour les couleurs des colonnes N O P on peut utiliser ce code :
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim P As Range
Set P = [N21:P30]: If Not Intersect(Target, P) Is Nothing Then Couleur P
Set P = [N35:P44]: If Not Intersect(Target, P) Is Nothing Then Couleur P
If Not Application.Intersect(Target, [B21:L30,B35:L44,R21:R30,Z35:Z44]) Is Nothing Then
    Application.EnableEvents = False
    On Error Resume Next 'Pour passer outre l'erreur en cas d'effacement
    Target = UCase(Target)
    Application.EnableEvents = True
End If
End Sub

Sub Couleur(P As Range)
Dim d1 As Object, d2 As Object, i&, x$, n&
Set d1 = CreateObject("Scripting.Dictionary")
Set d2 = CreateObject("Scripting.Dictionary")
For i = 1 To P.Rows.Count
    x = P(i, 1) & Chr(1) & P(i, 3)
    d1(x) = d1(x) + 1
Next
For i = 1 To P.Rows.Count
    x = P(i, 1) & Chr(1) & P(i, 3)
    If d1(x) > 1 Then
        If Not d2.exists(x) Then n = n + 1: d2(x) = n
        P.Rows(i).Font.Bold = True
        Select Case d2(x)
            Case 1: P.Rows(i).Font.ColorIndex = 3 'rouge
            Case 2: P.Rows(i).Font.ColorIndex = 5 'bleu
            Case 3: P.Rows(i).Font.ColorIndex = 46 'orange
            Case 4: P.Rows(i).Font.ColorIndex = 14 'vert
            Case 5: P.Rows(i).Font.ColorIndex = 53 'brun
        End Select
    Else
        P.Rows(i).Font.Bold = False
        P.Rows(i).Font.ColorIndex = xlAutomatic
    End If
Next
End Sub
Pour la couleur rouge des colonnes T:U et W:X il n'y a bien sûr rien de spécial à faire.
 

Fichiers joints

sebbbbb

XLDnaute Occasionnel
bonjour Job
merci pour ton retour
en fait il faut bien 10 couleurs car le but etant de distinguer toutes les dates et horaires différents
seb
 

sebbbbb

XLDnaute Occasionnel
Merci Laurent
je regarde et cela me semble pas mal
si je comprends bien tu as mis des MEFC c'est bien cela ?
seb
 

job75

XLDnaute Barbatruc
en fait il faut bien 10 couleurs car le but etant de distinguer toutes les dates et horaires différents
10 couleurs différentes vont créer le foutoir, on aura du mal à les distinguer les unes des autres.

Il sufft de convenir qu'on ne met pas de couleur quand les heures sont uniques, alors 5 maximum suffisent, c'est ma solution.
 

job75

XLDnaute Barbatruc
Une autre solution consiste à utiliser des bandes de couleurs de fond alternées, mais il faut alors trier les dates/heures :
VB:
Sub Couleur(P As Range)
Dim col, fusion, ub%, i&, j%, n&
col = Array(2, 6, 10, 12, 14, 16, 18)
fusion = Array(4, 3, 2, 2, 2, 2, 2)
ub = UBound(col)
Application.ScreenUpdating = False
Application.DisplayAlerts = False
P.EntireRow.UnMerge 'défusionne
P.EntireRow.Sort P(1), xlAscending, P(1, 3), , xlAscending, Header:=xlNo 'tri sur 2 colonnes
For i = 1 To P.Rows.Count
    For j = 0 To ub
        P.EntireRow.Cells(i, col(j)).Resize(, fusion(j)).Merge 'refusionne
    Next j
    If P(i, 1) & Chr(1) & P(i, 3) <> P(i - 1, 1) & Chr(1) & P(i - 1, 3) Then n = n + 1
    P.Rows(i).Interior.ColorIndex = IIf(n Mod 2, xlNone, 15) 'alternance de couleurs
Next i
End Sub
Fichier (2).
 

Fichiers joints

Dernière édition:

sebbbbb

XLDnaute Occasionnel
Bonjour Job
j'aime bcp cette solution car le tri se fait automatiquement sans que j'ai a cliquer sur le bouton
l'ideal serait un mix de cette solution avec celle que tu m'as proposé en premier
penses tu que celà soit faisable ?
merci
seb
 

job75

XLDnaute Barbatruc
La solution d'avoir 10 couleurs de police est débile, si vous avez un peu de jugeote vous le comprendrez.
 

sebbbbb

XLDnaute Occasionnel
je n'ai pas réitéré ma demande , j'ai juste proposé un mix de vos 2 solutions ; cad 5 couleurs avec un tri automatique

juste un ptit bug dans la 2e version le tri ne se fait pas avec les lignes 21 et 35

merci
seb
 

sebbbbb

XLDnaute Occasionnel
sinon je ne vois pas ce qu'il y a de débile a différencier d'une couleur différente chaque ligne unique (date et horaire unique), car il y a un risque de confusion justement entre 2 date identiques avec horaire d'arrivée différent (donc qui se retrouverait l'une sous l'autre)

il est vrai cependant que trop de couleur pourrait rendre indigeste le doc

merci
seb
 

sebbbbb

XLDnaute Occasionnel
merci
pensez vous donc qu'il est possible de garder votre 1ere version avec un tri automatique ?
seb
 

job75

XLDnaute Barbatruc
pensez vous donc qu'il est possible de garder votre 1ere version avec un tri automatique ?
Bien sûr, voyez ce fichier (3) :
VB:
Sub Couleur(P As Range)
Dim col, fusion, ub%, i&, j%, x$, n&
col = Array(2, 6, 10, 12, 14, 16, 18)
fusion = Array(4, 3, 2, 2, 2, 2, 2)
ub = UBound(col)
Application.ScreenUpdating = False
Application.DisplayAlerts = False
P.EntireRow.UnMerge 'défusionne
P.EntireRow.Sort P(1), xlAscending, P(1, 3), , xlAscending, Header:=xlNo 'tri sur 2 colonnes
For i = 1 To P.Rows.Count
    For j = 0 To ub
        P.EntireRow.Cells(i, col(j)).Resize(, fusion(j)).Merge 'refusionne
    Next j
    x = P(i, 1) & Chr(1) & P(i, 3)
    If x <> P(i - 1, 1) & Chr(1) & P(i - 1, 3) And x = P(i + 1, 1) & Chr(1) & P(i + 1, 3) Then n = n + 1
    If x = P(i + 1, 1) & Chr(1) & P(i + 1, 3) Or x = P(i - 1, 1) & Chr(1) & P(i - 1, 3) Then
        Select Case n
            Case 1: P.Rows(i).Font.ColorIndex = 3 'rouge
            Case 2: P.Rows(i).Font.ColorIndex = 5 'bleu
            Case 3: P.Rows(i).Font.ColorIndex = 46 'orange
            Case 4: P.Rows(i).Font.ColorIndex = 14 'vert
            Case 5: P.Rows(i).Font.ColorIndex = 53 'brun
        End Select
    Else
        P.Rows(i).Font.Bold = False
        P.Rows(i).Font.ColorIndex = xlAutomatic
    End If
Next i
End Sub
 

Fichiers joints

Haut Bas