XL 2016 Aide sur macro de date par rapport a une date de reference

[yves03]

Bonjour à tous,

J''essaie de résoudre le problème suivant, mais je ne sais pas comment l'aborder, si vous pouviez m'aider a dans ma démarche

Je souhaite pouvoir afficher dans la colonne C , a l'aide d'une macro le calcul suivant : Pouvoir saisir dans une msgbox une date de référence et afficher dans la colonne C uniquement les dates qui ont plus de 21 jours d’écart . Ex: si la date que je saisie dans la msgbox est 09/02/21 que je retire 21 jours cela fait 19/01/21, donc en C2, j'affiche la date qui est en B2 soit 18/01/21 pour les lignes ou il y a >1 year, j'affiche >1 year. Pour la cellule B8 si j’enlève 21 jours par rapport au 09/02/21 ça fait 11/01/21, donc je laisse vide la cellule C8

Je vous remercie par avance pour votre aide

 

[sylvanu]

Bonsoir Yves,
Un essai en PJ avec en C2 :

=SI(ESTNUM(B2);SI($F$2-B2>=21;B2;"");B2)

 

[Robert]

Bonsoir Yves, bonsoir le forum,

En pièce jointe ton fichier modifié avec le code ci-dessous :

Sub Macro1()
Dim O As Worksheet 'déclare la variable O (Onglet)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim BE As Variant 'déclare la variable BE (Boîte d'Entrée)
Dim DR As Long 'déclare la variable DR (Date de référence)
Dim DT As Long 'déclare la variable DT (Date du Tableau)
Dim I As Integer 'déclare la variable I (Incrément)

Set O = Worksheets("Feuil1") 'définit l'onglet O
TV = O.Range("B1").CurrentRegion 'définit le tableau des valeurs TV
O.Range("C2:C" & Application.Rows.Count).ClearContents 'efface les donnée de la colonne C (à partie de C2)
O.Range("E2:F2").ClearContents 'efface le contenu de la plage D2:E2
ici: 'étiquette
BE = Application.InputBox("Taper la date au format jj/mm/aaaa", "Date de Référence", Type:=2) 'définit la boîte d'entrée BE
If BE = False Then Exit Sub 'si bouton [Annuler] sort de la procédure
If IsDate(BE) = False Then 'condition : si BE n'est pas une date
    MsgBox "Date non valide !" 'message
    GoTo ici 'va à l'étiquette "ici"
End If 'fin de la condition
DR = CLng(DateSerial(Year(BE), Month(BE), Day(BE))) 'définit la date de référence  DR (en entier long)
O.Range("E2") = Format(DR, "dd/mm/yyyy") 'renvoie la date de référence en D2
O.Range("F2") = Format(DR - 21, "dd/mm/yyyy") 'renvoie la date de référence emoins 21 jours en E2
For I = 2 To UBound(TV, 1) 'boucle sur toutes les ligne I du tableau des valeurs TV (en partant de la seconde)
    Select Case TV(I, 1) 'agit en fonction de la donnée ligne I colonne 1 de TV
        Case ">1 year" 'cas ">1 year"
            O.Cells(I, "C") = ">1 year" 'renvoie la valeur dans la cellule en colonne C
        Case Else 'tous les autres cas
            DT = CLng(DateSerial(Year(TV(I, 1)), Month(TV(I, 1)), Day((TV(I, 1))))) 'définit la date du tableau DT (en entier long)
            If DT <= DR - 21 Then O.Cells(I, "C") = Format(DT, "dd/mm/yyyy") 'si la date du tableu DT est inférieure ou égale à la date de référende moisn 21 jours, renvoie la date DR au format jj/mm/aaaa dans la colonne C
    End Select 'fin de l'action en fonction de la donnée ligne I colonne 1 de TV
Next I 'prochaine ligne de la boucle
End Sub

Le fichier :

 

[yves03]

Bonsoir Yves, bonsoir le forum,

En pièce jointe ton fichier modifié avec le code ci-dessous :

Sub Macro1()
Dim O As Worksheet 'déclare la variable O (Onglet)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim BE As Variant 'déclare la variable BE (Boîte d'Entrée)
Dim DR As Long 'déclare la variable DR (Date de référence)
Dim DT As Long 'déclare la variable DT (Date du Tableau)
Dim I As Integer 'déclare la variable I (Incrément)

Set O = Worksheets("Feuil1") 'définit l'onglet O
TV = O.Range("B1").CurrentRegion 'définit le tableau des valeurs TV
O.Range("C2:C" & Application.Rows.Count).ClearContents 'efface les donnée de la colonne C (à partie de C2)
O.Range("E2:F2").ClearContents 'efface le contenu de la plage D2:E2
ici: 'étiquette
BE = Application.InputBox("Taper la date au format jj/mm/aaaa", "Date de Référence", Type:=2) 'définit la boîte d'entrée BE
If BE = False Then Exit Sub 'si bouton [Annuler] sort de la procédure
If IsDate(BE) = False Then 'condition : si BE n'est pas une date
    MsgBox "Date non valide !" 'message
    GoTo ici 'va à l'étiquette "ici"
End If 'fin de la condition
DR = CLng(DateSerial(Year(BE), Month(BE), Day(BE))) 'définit la date de référence  DR (en entier long)
O.Range("E2") = Format(DR, "dd/mm/yyyy") 'renvoie la date de référence en D2
O.Range("F2") = Format(DR - 21, "dd/mm/yyyy") 'renvoie la date de référence emoins 21 jours en E2
For I = 2 To UBound(TV, 1) 'boucle sur toutes les ligne I du tableau des valeurs TV (en partant de la seconde)
    Select Case TV(I, 1) 'agit en fonction de la donnée ligne I colonne 1 de TV
        Case ">1 year" 'cas ">1 year"
            O.Cells(I, "C") = ">1 year" 'renvoie la valeur dans la cellule en colonne C
        Case Else 'tous les autres cas
            DT = CLng(DateSerial(Year(TV(I, 1)), Month(TV(I, 1)), Day((TV(I, 1))))) 'définit la date du tableau DT (en entier long)
            If DT <= DR - 21 Then O.Cells(I, "C") = Format(DT, "dd/mm/yyyy") 'si la date du tableu DT est inférieure ou égale à la date de référende moisn 21 jours, renvoie la date DR au format jj/mm/aaaa dans la colonne C
    End Select 'fin de l'action en fonction de la donnée ligne I colonne 1 de TV
Next I 'prochaine ligne de la boucle
End Sub

Le fichier :

Bonjour Robert,

Merci beaucoup pour ce travail, par contre je rencontre un petit soucis, quand je tape une date dans la fenêtre Ex: 09/02/2021 en cellule E2 il s'affiche 02/09/2021, elle s'inverse
Merci pour ton aide

 

[yves03]

Bonsoir Yves,
Un essai en PJ avec en C2 :

=SI(ESTNUM(B2);SI($F$2-B2>=21;B2;"");B2)

Bonjour Sylvanu,
Merci beaucoup pour ton aide

 

[sylvanu]

Bonjour,
Il faut mettre la colonne C dans le même format que la colonne B
jj/mm/aaaa

 

[yves03]

Bonjour,
Il faut mettre la colonne C dans le même format que la colonne B
jj/mm/aaaa

oui j'ai bien mis la colonne B et C dans le meme format , mais c'est la cellule E2 qui inverse la date saisie dans la msgbox

 

[sylvanu]

Bonjour Yves, robert,
Oups, j'avais pas vu.
Pour une raison qui m'échappe, si la syntaxe est :

O.Range("E2") = Format(DR, "dd/mm/yyyy")  'renvoie la date de référence en D2
O.Range("F2") = Format(DR - 21, "dd/mm/yyyy") 'renvoie la date de référence emoins 21 jours en E2

alors on a 02/10/2021.
Mais avec celle ci :

O.Range("E2") = DR                            'renvoie la date de référence en D2
O.Range("F2") = Format(DR - 21, "dd/mm/yyyy") 'renvoie la date de référence emoins 21 jours en E2

On a bien 10/02/2021.
Voir PJ

 

[Robert]

Bonjour le fil, bonjour le forum,

Désolé pour le retard !... Mais je suis tranquille car je sais qu'il y a toujours quelqu'un de bienveillant qui veille au grain dans ce forum. En plus, Sylvanu !... Un balèze de chez les balèzes...

Merci Sylvanu d'avoir pris la relève.

 

[sylvanu]

Re,
Par contre je n'ai pas compris pourquoi.
Qui plus est, si on fait :

O.Range("E2") = Format(DR, "dd/mm/yyyy")
On obtient un affichage mm/jj/aaaa

si on fait

O.Range("E2") = DR
On obtient un affichage jj/mm/aaaa

mais si on fait

O.Range("E2") = Format(DR - 9, "dd/mm/yyyy")
On obtient un affichage mm/jj/aaaa
mais
O.Range("E2") = Format(DR - 10, "dd/mm/yyyy")
On obtient un affichage jj/mm/aaaa

Et ça je ne comprends pas.

 

[Robert]

Re,

Je ne me pose plus ce genre de question tellement j'ai galéré avec les dates d'autant plus que j'utilise un clavier US avec le portugais comme langue par défaut... C'est Excel qui décide pour moi. Parfois je formate la date avant et je renvoie l'entier long et ça marche, parfois non. Je m'adapte...
Mais, tout comme toi si quelqu'un a une explication je prends...

 

[yves03]

Merci a tous les 2 pour votre aide