XL 2010 VBA - Comparaison de cellules selon couleurs et autres joyeusetés

[Newbeee]

Bonjour à tous,


Nécessité fait loi, je me suis mise à vba….ce week-end. J’ai bricolé une macro grâce à vos réponses précédentes à d’autres novices , mais maintenant je me sens bloquée pour la prochaine étape…

Mon fichier (ci-joint) est basé sur un calendrier par jour que je dois adapter pour en faire un fichier par période de quart de mois grosso modo. De « Planning 2018 », la macro arrive pour l’instant à faire (un peu par miracle) « Planning OCs », mais pour arriver ensuite à « Resultat attendu », c’est le gros point d’interrogation….

1er problème

Chaque mois est en divisé en 4 périodes (pas en vraies semaines donc). Je ne sais pas quoi utiliser pour définir les périodes du 1 au 7/ du 8 au 14/du 15 au 22/du 22 à la fin du mois (28, 29, 30 ou 31) ? Une plage et une boucle ? Comment peut-on faire ça ?

2eme probleme

De +/- 7 cellules je dois en faire 1. Le jeu est que pour chaque jour de la semaine, je peux avoir une couleur différente, mais dans le tableau attendu, elles sont priorisées :

- S’il y a deux cellules ou plus rouges dans la semaine, la cellule correspondant à la période doit être rouge.

- S’il n’y a pas de rouge mais qu’il y a deux ou plus cellules oranges dans la période, la cellule correspondant à la période doit être orange

Comment comparer le nombre de cellules de chaque couleur sur une période pour décider quelle sera la couleur de la période ? Là encore, plage et boucle ?

3eme problème

Est-ce qu’on peut transformer le tableau sans en refaire un nouveau ? Ainsi la cellule E3 serait modifiée selon les couleurs présentes sur la plage E3-K3, la cellule E4 selon les couleurs présentes sur la plage L3-R3, etc….

J’ai cherché sur différents forums mais je suis vite bloquée par mon manque de vocabulaire technique, du coup la formulation de mes recherches vous ferait certainement rire…

Merci d’avance pour tout ce que vous voudrez bien partager : pistes, bouts de macro ou macro, correcte reformulation de mes questions, commentaires pour expliquer les macros….

 

[vgendron]

Hello
Tu as oublié de joindre le fichier :-D

 

[Newbeee]

Oups..... Le voilà!

 

[vgendron]

Hello

quelques pistes à creuser

1er problème

Chaque mois est en divisé en 4 périodes (pas en vraies semaines donc). Je ne sais pas quoi utiliser pour définir les périodes du 1 au 7/ du 8 au 14/du 15 au 22/du 22 à la fin du mois (28, 29, 30 ou 31) ? Une plage et une boucle ? Comment peut-on faire ça ?

pour définir les dates: utiliser la fonction Date(année;mois;jour) ==> date(2018;01;01) / date(2018;2;7) ...
et fin.mois(date();0)
fin.mois(date(2018;1;1);0) = 31/01/2018
fin.mois(date(2018;1;1);1) = 28/02/2018 ce qui est aussi =fin.mois(date(2018;1;1);0)

2eme probleme

De +/- 7 cellules je dois en faire 1. Le jeu est que pour chaque jour de la semaine, je peux avoir une couleur différente, mais dans le tableau attendu, elles sont priorisées :

- S’il y a deux cellules ou plus rouges dans la semaine, la cellule correspondant à la période doit être rouge.

- S’il n’y a pas de rouge mais qu’il y a deux ou plus cellules oranges dans la période, la cellule correspondant à la période doit être orange

Comment comparer le nombre de cellules de chaque couleur sur une période pour décider quelle sera la couleur de la période ? Là encore, plage et boucle ?

Ton tableau final semble ne rien avoir dans ces cellules. juste des couleurs..
on pourrait en profiter pour attribuer des valeurs au couleurs
Rouge = 3
Orange=2
Vert=1
et suffit de compter le nombre de 1 de 2 et de 3
on prend la valeur max pour mettre le code couleur qui va bien, associé à une MFC ===> comme ca.. ca répond au problème 3 en meme temps..

3eme problème

Est-ce qu’on peut transformer le tableau sans en refaire un nouveau ? Ainsi la cellule E3 serait modifiée selon les couleurs présentes sur la plage E3-K3, la cellule E4 selon les couleurs présentes sur la plage L3-R3, etc….

 

[vgendron]

un début de réponse

 

[vgendron]

Re moi !
Bon voici ce que j'ai pu faire pour aller au bout..
par contre. je n'ai pas le meme résultat attendu que toi. seule la première période de Janvier est en rouge..

 

[Newbeee]

Waou! Merci mille fois! Je n'y aurais jamais pensé.... et j'aurais encore moins su le faire. Grâce à tes commentaires (merci merci merci!) je comprends le code mais sans doute pas toutes ses subtilités. Or quand je lance la macro sur le tableau complet, j'ai une boite de dialogue qui indique 16 et qui surtout ne peut se fermer et je ne comprends pas pourquoi.
Il y a quelques différences entre l'extrait et le tableau complet: dans le tableau complet il peut y avoir des commentaires et du texte dans certaines cellules (dont on n' a pas besoin dans le résultat attendu, donc aucun pb pour les effacer), et les premières lignes diffèrent (certaines cellules sont fusionnées). Mais j'ai modifié tout ça comme c'était dans l'extrait et la boîte de dialogue continue d'apparaître...

 

[vgendron]

Hello
le problème vient de la couleur Grise qui entre dans le case 'Else Case" de la macro ==> j'ai mis le msgbox en commentaire
==> du coup le gris devient rouge au final


et il faut absolument que tu remettes la date en ligne 1 (pas juste Mo, Tu, Wed...) mais bien la date complète: sinon, le code ne va plus fonctionner, puisqu'il a besoin de cette date pour déterminer les périodes.
tu peux par contre appliquer un format personalisé à la ligne 1 pour n'afficher que le jour
dans la PJ, le nom apparait en français puisque j'ai une version Excel Francais...

voir PJ

 

[Newbeee]

Encore une fois, merci vgendron! J'ai un (j'espère tout dernier) blocage: il y a un décalage dans ton fichier, dû à mon passage de 2 lignes avant le corps du tableau (dans le fichier test) à 3 lignes (le dernier fichier que j'ai envoyé), ce qui fausse les données car ce ne sont plus les bonnes lignes qui sont comparées. J'ai essayé de décaler les selections, pour prendre en compte cela, mais j'ai toujours une erreur sur la ligne en rouge ci-dessous.

'on recopie la mise en forme des deux premières lignes de la feuille Planning 2018
.Rows("1:2").Copy
Sheets("Planning_OCs").Rows("1:2").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Columns("E").Resize(, UBound(TabOcs, 2) - 4).ColumnWidth = 0.83
Range("A1").Select
Rows(3).Delete

Si j'ai encore droit à un voeu, qu'est-ce qu'il faut faire? J'ai tenté de supprimer la ligne 3 à la fin de la création de la création de Planning_OCs, de changer les selections des plages,... Je loupe un truc,mais quoi et comment le corriger?

 

[vgendron]

Hello !

Si j'ai encore droit à un voeu,

tu m'as pris pour un génie?? :-D

trève de plaisanterie
Peux tu renvoyer ton fichier pour me montrer quelle ligne tu as ajoutée
parce que en plus du code ci dessous, (que je viens de commenter)

on recopie la mise en forme des deux premières lignes de la feuille Planning 2018
.Rows("1:2").Copy 'on copie les lignes 1 et 2 de la feuille "Planning 2018"
Sheets("Planning_OCs").Rows("1:2").Select 'on selectionne les deux lignes correspondantes (1 et 2) de la feuille "Planning Ocs" ==> si tu as décalé pour que ce soit les lignes 2 et 3: suffit de modifier par Rows(2:3)
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False 'et on fait le collage special de la mise en forme
Application.CutCopyMode = False
Columns("E").Resize(, UBound(TabOcs, 2) - 4).ColumnWidth = 0.83
Range("A1").Select
Rows(3).Delete

il y a peut etre celui ci à modifier aussi. selon ce que tu veux au final

 With Sheets("Planning_Ocs") 'dans la feuille "Planning_Ocs"
        .Range("A1").Resize(UBound(TabPlan, 1), UBound(TabPlan, 2)) = TabPlan 'on colle le tablo

 

[Newbeee]

Voilà le fichier!
Ca a finalement marché (c'est pas très propre, il manque l'entête des 4 premières colonnes (nom/projet/position/name), mais je n'ai pas trouvé mieux, et quand j'essaie de la coller ensuite, ça ne marche pas...).

Du coup j'ai continué... et là:
- pourquoi la couleur de police que j'ajoute à ta MFC sur "resultat attendu" ne marche pas? (je voulais que la couleur de la police soit la même que la couleur de la cellule)
- pourquoi la fusion des cellules par 4 sur la ligne 2 ne marche pas, même en specifiant les cellules à fusionner? Ca part en cachouete en Juillet jusqu'à la fin de l'année...
- pourquoi quand j'essaie de formater les dates en "mmm" ça les efface?

Enfin il y a un souci dans les 2 dernières colonnes: l'avant-dernière est une colonne grise (mais avec une date en en-tete) et la dernière a les données qui devraient être sous la date de l'avant dernière. Et mon cerveau bug.

 

[Newbeee]

Hello,

De retour de vacances, mais toujours sur ce même fichier!
2019 arrive, du coup j'ai voulu ajouter ces dates au fichier ci-joint sans succès, et je ne comprends pas pourquoi puisque c'est une fonction Ubound qui est utilisée... Des pistes?

NbMois = Month(TabPlan(1, UBound(TabPlan, 2)))
DernierJour = TabPlan(1, UBound(TabPlan, 2))
nb = Int((DernierJour - DateSerial(Year(DernierJour), Month(DernierJour), 1)) / 7) + 1
NbPériode = (NbMois - 1) * 4 + nb
ReDim TabFin(1 To UBound(TabOcs, 1), 1 To 11 + NbPériode)

Dim D As Date
Dim fm As Date

D = DateSerial(2018, 1, 1) 'premier jour de la première période = 01/01/2018
dateMax = TabOcs(1, UBound(TabOcs, 2)) 'dernière date du tableau dans Planning_Ocs 2018
j = 12 'pour commencer à la colonne E
NumPériode = 0
While D <= dateMax And j <= UBound(TabOcs, 2) 'tant qu'on a pas parcouru toutes les dates
fm = WorksheetFunction.EoMonth(D, 0) 'fin mois
TabFin(2, j) = WorksheetFunction.Min(D, fm) 'on met le minimum entre la date et la fin du mois
j = j + 1 'colonne suivante pour TabFin
NumPériode = NumPériode + 1 'nombre de période dans le mois en cours
If Month(D + 7) = Month(D) And NumPériode < 4 Then '4 périodes par mois
D = D + 7
Else
D = fm + 1
NumPériode = 0
End If
Wend

J'en profite pour revenir sur la question du format conditionnel de la police: qu'est6ce qui fait que la couleur n'est pas celle du fond de la cellule comme je pensais l'avoir écrit dans la macro?

With .Range("L4").Resize((UBound(TabFin, 1) - 2), UBound(TabFin, 2) - 11)
'Rouge si 0 ou 4
.FormatConditions.Add Type:=xlExpression, Formula1:="=OU(4;0)"
.FormatConditions(.FormatConditions.Count).SetFirstPriority
With .FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
End With
With .Font
.Color = 255
End With
.FormatConditions(1).StopIfTrue = False

 

[vgendron]

Hello

pour le problème de dates 2019...
je pense que le problème vient du calcul du NbMois dans la macro.. ici: on considérait qu'il ne pouvait y avoir qu'une seule année sur le calendrier

'************************************Début Création Feuille Resultat attendu 2018************************************************************
'on détermine le nombre de mois dans le calendrier
PremierJour = TabPlan(1, 12)
DernierJour = TabPlan(1, UBound(TabPlan, 2))
If Year(DernierJour) <> Year(PremierJour) Then
    NbMois = Month(TabPlan(1, UBound(TabPlan, 2))) + (Year(DernierJour) - Year(PremierJour)) * 12
Else
    NbMois = Month(TabPlan(1, UBound(TabPlan, 2)))
End If

Pour les couleurs de cellules..
sans certitude..
la couleur de fond d'une cellule n'est PAS la même selon la façon qu'elle est appliquée:
Cell.interior.color renvoie la couleur appliquée "manuellement", mais ne tient pas compte d'une couleur qui pourrait aussi etre appliquée par MFC sur cette meme cellule.
un exemple sur la feuil1
en D4, j'ai coloré la cellule en Jaune par défaut PUIS j'ai ajouté une MFC qui colore en rouge si la cellule est vide
en D6, j'ai juste coloré la cellule en rouge. (pas de MFC)

quand tu effaces la cellule D4 ==> elle passe en rouge grace à la MFC: pourtant l'index couleur ne change pas.. il garde celui du JAUNE par défaut
une macro te donne l'index couleur de la cellule D4 en F4
et celui des cellules D8 et D9 pour référence