MFC imbriquée date dépassée + mois courant

Le 12/09/2023 à 08:14

Bonjour à toutes et tous

Je beau retourner mon problème dans tous les sens impossible de trouver et de mettre au point cette mise en forme conditionnelle.

En effet, je cherche à mettre de couleur orange, les cellules d’une colonne dont la date est comprise dans le mois courant et en rouge si cette date dépasse le dernier jour du mois courant.

Je souhaiterais pouvoir imbriquer ces deux formules dans une mise en forme conditionnelle car des lignes peuvent être rajouté de temps en temps et surtout a n’importe quel endroit.

Si je pouvais obtenir de l’aide ce serait sympa, un grand merci par avance.

Le 12/09/2023 à 08:53

Bonjour,

image 
=J1>FIN.MOIS(AUJOURDHUI();0) => rouge
=MOIS(J1)=MOIS(AUJOURDHUI()) => orange

S'applique à : =$J:$J

A+

Le 12/09/2023 à 09:04

Bonjour,

Merci pour ce coup de pouce, je parviens a faire la couleur orange mais pas la rouge :(

J'insère mon fichier en PJ

3classeur1.xlsx (9.05 Ko)
Le 12/09/2023 à 09:11

J'ai mal compris ta demande sur le rouge le premier coup.
Avec ça peut-etre ?

=A1>FIN.MOIS(AUJOURDHUI();0)
6classeur1.xlsx (9.65 Ko)
Le 12/09/2023 à 09:23

Je tiens tout d'abord à te remercier, on est vraiment pas loin je pense.

J'ai mis en colonne C le résultat attendu avec les couleur en "dur".

Précision, S'il n'y a pas de date dans la cellule sur toute la colonne, elle doit rester blanche. Le format des dates sera au format XX/XXXX, il n'y a pas de notions de jour.

5classeur1.xlsx (9.65 Ko)
Le 12/09/2023 à 09:26

Tu n'as sans doute pas mis la bonne piece jointe

Le 12/09/2023 à 09:33

C'est mieux comme ceci ?

3classeur1.xlsx (9.16 Ko)
Le 12/09/2023 à 09:40

Comme ça :

=ET(MOIS(A1)<MOIS(AUJOURDHUI());A1<>"")
3classeur1.xlsx (9.51 Ko)

A+

Le 12/09/2023 à 10:05

C'est génial, cela fonctionne super bien.

Merci de m'avoir accordé de ton temps.

Je te souhaite une belle journée.

Le 13/09/2023 à 13:22

Bonjour GEOF52,

J'ai commencer a saisir des dates cependant les MFC ne fonctionnent plus comme sur le fichier test.

Je n'y comprends plus rien, pourtant c'était nickel, tu aurais une idée ? C'est sur l'onglet consommables :(

Merci par avance.

5gestion-des-stocks-phamacie.xlsm (84.78 Ko)
Le 13/09/2023 à 13:33

Bonjour dyscus,

image

Il faut mette D1 dans la formule si tu applique a toute la colonne et pas D3.
Sinon la couleur va se mettre 2 lignes au dessus de ou elle doit etre.

Par contre il y a bien un autre probleme, on ne prend pas en compte les années.
Du coup le 05/05/2025 est en rouge alors qu'il ne faudrait pas.

Donc MFC en Rouge :

=OU(ET(MOIS(D1)<MOIS(AUJOURDHUI());ANNEE(D1)<ANNEE(AUJOURDHUI());D1<>"");ET(ANNEE(D1)<ANNEE(AUJOURDHUI());D1<>""))

En Orange :

=ET(MOIS(D1)=MOIS(AUJOURDHUI());ANNEE(D1)=ANNEE(AUJOURDHUI()))

Pour la macro j'en ai profité pour faire une boucle comme évoqué sur le sujet (Lien)

8gestion-des-stocks-phamacie-v3.xlsm (82.69 Ko)

A+

Le 13/09/2023 à 15:15

Merci GEOF, je comprends mieux le fonctionnement de la MFC et le décalage occasionné.

Par contre si je met 05/2022 j'ai du rouge mais si je mets 05/2023 cela reste blanc, on dirait qu'il y a un soucis avec l'année en cours.

J'ai regardé la MFC mais ça dépasse mes compétences.

Le 13/09/2023 à 15:27

Hop la, j'ai fait n'importe quoi

Essai avec cette MFC pour le rouge :

=ET(DATE(ANNEE(D1);MOIS(D1);1)<DATE(ANNEE(AUJOURDHUI());MOIS(AUJOURDHUI());1);D1<>"")

S'applique à :

=$D:$D;$F:$F;$H:$H

(pas seulement la colonne D)
Je regarde la macro un peu plus tard

Le 13/09/2023 à 15:35

Super !! Par contre, les cellules rouges ne sont pas reprises sur la synthèse lors de la génération de la commande.

Je suis désolé :(

EDIT ok merci, j'avais pas vu que tu regardais la macro + tard merci encore

Le 13/09/2023 à 15:43

Voila la macro a mettre dans le module 1 (supprime tout et remets l'enssemble du code ci-dessous)

Option Explicit
Dim LigneOrange, LigneRouge, Ligne, DerLigne As Integer
Dim DateD, DateF, DateH As Variant

Sub GenereCmd()
EffaceCmd

LigneOrange = 3
LigneRouge = 3

'GENERER LA COMMANDE PHARMACIE
DerLigne = Feuil1.Cells(Rows.Count, 1).End(xlUp).Row
For Ligne = 1 To DerLigne
    'Colonne D
    DateD = Feuil1.Cells(Ligne, 4).Value
    If IsDate(DateD) Then
        If Month(DateD) = Month(Date) And Year(DateD) = Year(Date) Then 'Orange
            Feuil7.Cells(LigneOrange, 1).Value = Feuil1.Cells(Ligne, 1).Value
            Feuil7.Cells(LigneOrange, 2).Value = Feuil1.Cells(Ligne, 2).Value
            LigneOrange = LigneOrange + 1
        End If
        If DateSerial(Year(DateD), Month(DateD), 1) < DateSerial(Year(Date), Month(Date), 1) Then 'Rouge
            Feuil7.Cells(LigneRouge, 4).Value = Feuil1.Cells(Ligne, 1).Value
            Feuil7.Cells(LigneRouge, 5).Value = Feuil1.Cells(Ligne, 2).Value
            LigneRouge = LigneRouge + 1
        End If
    End If
    'Colonne F
    DateF = Feuil1.Cells(Ligne, 6).Value
    If IsDate(DateF) Then
        If Month(DateF) = Month(Date) And Year(DateF) = Year(Date) Then 'Orange
            Feuil7.Cells(LigneOrange, 1).Value = Feuil1.Cells(Ligne, 1).Value
            Feuil7.Cells(LigneOrange, 2).Value = Feuil1.Cells(Ligne, 2).Value
            LigneOrange = LigneOrange + 1
        End If
        If DateSerial(Year(DateF), Month(DateF), 1) < DateSerial(Year(Date), Month(Date), 1) Then 'Rouge
            Feuil7.Cells(LigneRouge, 4).Value = Feuil1.Cells(Ligne, 1).Value
            Feuil7.Cells(LigneRouge, 5).Value = Feuil1.Cells(Ligne, 2).Value
            LigneRouge = LigneRouge + 1
        End If
    End If
    'Colonne H
    DateH = Feuil1.Cells(Ligne, 8).Value
    If IsDate(DateH) Then
        If Month(DateH) = Month(Date) And Year(DateH) = Year(Date) Then 'Orange
            Feuil7.Cells(LigneOrange, 1).Value = Feuil1.Cells(Ligne, 1).Value
            Feuil7.Cells(LigneOrange, 2).Value = Feuil1.Cells(Ligne, 2).Value
            LigneOrange = LigneOrange + 1
        End If
        If DateSerial(Year(DateH), Month(DateH), 1) < DateSerial(Year(Date), Month(Date), 1) Then 'Rouge
            Feuil7.Cells(LigneRouge, 4).Value = Feuil1.Cells(Ligne, 1).Value
            Feuil7.Cells(LigneRouge, 5).Value = Feuil1.Cells(Ligne, 2).Value
            LigneRouge = LigneRouge + 1
        End If
    End If

Next Ligne

'bordure
With Feuil7.Cells(3, 1).CurrentRegion
    .Borders(xlEdgeLeft).LineStyle = xlContinuous
    .Borders(xlEdgeTop).LineStyle = xlContinuous
    .Borders(xlEdgeBottom).LineStyle = xlContinuous
    .Borders(xlEdgeRight).LineStyle = xlContinuous
    .Borders(xlInsideVertical).LineStyle = xlContinuous
    .Borders(xlInsideHorizontal).LineStyle = xlContinuous
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlCenter
End With

With Feuil7.Cells(3, 4).CurrentRegion
    .Borders(xlEdgeLeft).LineStyle = xlContinuous
    .Borders(xlEdgeTop).LineStyle = xlContinuous
    .Borders(xlEdgeBottom).LineStyle = xlContinuous
    .Borders(xlEdgeRight).LineStyle = xlContinuous
    .Borders(xlInsideVertical).LineStyle = xlContinuous
    .Borders(xlInsideHorizontal).LineStyle = xlContinuous
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlCenter
End With

End Sub

Sub EffaceCmd()
'EFFACER  LA COMMANDE PHARMACIE
    Feuil7.Range("A3:B10000").Clear
    Feuil7.Range("D3:E10000").Clear
End Sub

A+

Le 14/09/2023 à 09:36

Bonjour ,

J'espère que tu vas bien.

La problématique liée aux MFC est bien reglée c'est super, par contre la synthèse fonctionne uniquement avec l'onglet consommables et non avec l'ensemble des 7.

Dans la macro je vois Feuil1 mais pas les autres, je ne sais pas comment nous pourrions les déclarer ?

Toutes les colonnes sont identiques pour les dates : D - F - H

Merci a nouveau de ton aide.

Le 14/09/2023 à 09:48

Bonjour dyscus,

Exact, il était temps d'aller dormir hier , je ne t'ai surement pas copier le bon code.
Voila Feuil1 remplacé par Worksheets(Feuille) avec Feuille allant de 1 a 6

Option Explicit
Dim LigneOrange, LigneRouge, Ligne, DerLigne As Integer
Dim DateD, DateF, DateH As Variant
Dim Feuille As Byte

Sub GenereCmd()
EffaceCmd

LigneOrange = 3
LigneRouge = 3

'GENERER LA COMMANDE PHARMACIE
For Feuille = 1 To 6
    DerLigne = Worksheets(Feuille).Cells(Rows.Count, 1).End(xlUp).Row
    For Ligne = 1 To DerLigne
        'Colonne D
        DateD = Worksheets(Feuille).Cells(Ligne, 4).Value
        If IsDate(DateD) Then
            If Month(DateD) = Month(Date) And Year(DateD) = Year(Date) Then 'Orange
                Feuil7.Cells(LigneOrange, 1).Value = Worksheets(Feuille).Cells(Ligne, 1).Value
                Feuil7.Cells(LigneOrange, 2).Value = Worksheets(Feuille).Cells(Ligne, 2).Value
                LigneOrange = LigneOrange + 1
            End If
            If DateSerial(Year(DateD), Month(DateD), 1) < DateSerial(Year(Date), Month(Date), 1) Then 'Rouge
                Feuil7.Cells(LigneRouge, 4).Value = Worksheets(Feuille).Cells(Ligne, 1).Value
                Feuil7.Cells(LigneRouge, 5).Value = Worksheets(Feuille).Cells(Ligne, 2).Value
                LigneRouge = LigneRouge + 1
            End If
        End If
        'Colonne F
        DateF = Worksheets(Feuille).Cells(Ligne, 6).Value
        If IsDate(DateF) Then
            If Month(DateF) = Month(Date) And Year(DateF) = Year(Date) Then 'Orange
                Feuil7.Cells(LigneOrange, 1).Value = Worksheets(Feuille).Cells(Ligne, 1).Value
                Feuil7.Cells(LigneOrange, 2).Value = Worksheets(Feuille).Cells(Ligne, 2).Value
                LigneOrange = LigneOrange + 1
            End If
            If DateSerial(Year(DateF), Month(DateF), 1) < DateSerial(Year(Date), Month(Date), 1) Then 'Rouge
                Feuil7.Cells(LigneRouge, 4).Value = Worksheets(Feuille).Cells(Ligne, 1).Value
                Feuil7.Cells(LigneRouge, 5).Value = Worksheets(Feuille).Cells(Ligne, 2).Value
                LigneRouge = LigneRouge + 1
            End If
        End If
        'Colonne H
        DateH = Worksheets(Feuille).Cells(Ligne, 8).Value
        If IsDate(DateH) Then
            If Month(DateH) = Month(Date) And Year(DateH) = Year(Date) Then 'Orange
                Feuil7.Cells(LigneOrange, 1).Value = Worksheets(Feuille).Cells(Ligne, 1).Value
                Feuil7.Cells(LigneOrange, 2).Value = Worksheets(Feuille).Cells(Ligne, 2).Value
                LigneOrange = LigneOrange + 1
            End If
            If DateSerial(Year(DateH), Month(DateH), 1) < DateSerial(Year(Date), Month(Date), 1) Then 'Rouge
                Feuil7.Cells(LigneRouge, 4).Value = Worksheets(Feuille).Cells(Ligne, 1).Value
                Feuil7.Cells(LigneRouge, 5).Value = Worksheets(Feuille).Cells(Ligne, 2).Value
                LigneRouge = LigneRouge + 1
            End If
        End If
    Next Ligne
Next Feuille

'bordure
With Feuil7.Cells(3, 1).CurrentRegion
    .Borders(xlEdgeLeft).LineStyle = xlContinuous
    .Borders(xlEdgeTop).LineStyle = xlContinuous
    .Borders(xlEdgeBottom).LineStyle = xlContinuous
    .Borders(xlEdgeRight).LineStyle = xlContinuous
    .Borders(xlInsideVertical).LineStyle = xlContinuous
    .Borders(xlInsideHorizontal).LineStyle = xlContinuous
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlCenter
End With

With Feuil7.Cells(3, 4).CurrentRegion
    .Borders(xlEdgeLeft).LineStyle = xlContinuous
    .Borders(xlEdgeTop).LineStyle = xlContinuous
    .Borders(xlEdgeBottom).LineStyle = xlContinuous
    .Borders(xlEdgeRight).LineStyle = xlContinuous
    .Borders(xlInsideVertical).LineStyle = xlContinuous
    .Borders(xlInsideHorizontal).LineStyle = xlContinuous
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlCenter
End With

End Sub

Sub EffaceCmd()
'EFFACER  LA COMMANDE PHARMACIE
    Feuil7.Range("A3:B10000").Clear
    Feuil7.Range("D3:E10000").Clear
End Sub

A+

Le 14/09/2023 à 09:55

Un grand merci a nouveau c'est fonctionnel pour tous les onglets, bravo !

Rechercher des sujets similaires à "mfc imbriquee date depassee mois courant"