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

sebbbbb · 15 Juin 2019

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

sebbbbb · 16 Juin 2019

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

job75 · 16 Juin 2019

sebbbbb à dit:
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

sebbbbb · 16 Juin 2019

cool
merci bcp

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

sebbbbb

XLDnaute Impliqué

Pièces jointes

sebbbbb

XLDnaute Impliqué

job75

XLDnaute Barbatruc

Pièces jointes

sebbbbb

XLDnaute Impliqué

Discussions similaires