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

yves03

XLDnaute Occasionnel
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
 

Pièces jointes

  • Test retrancher jour a une date.xlsx
    9.5 KB · Affichages: 12

Robert

XLDnaute Barbatruc
Repose en paix
Bonsoir Yves, bonsoir le forum,

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

VB:
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 :
 

Pièces jointes

  • Yves_ED_v01.xlsm
    23.8 KB · Affichages: 5

yves03

XLDnaute Occasionnel
Bonsoir Yves, bonsoir le forum,

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

VB:
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
 

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour Yves, robert,
Oups, j'avais pas vu. :rolleyes:
Pour une raison qui m'échappe, si la syntaxe est :
VB:
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 :
VB:
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
 

Pièces jointes

  • Yves_ED_v02.xlsm
    21.6 KB · Affichages: 5

Robert

XLDnaute Barbatruc
Repose en paix
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

XLDnaute Barbatruc
Supporter XLD
Re,
Par contre je n'ai pas compris pourquoi.
Qui plus est, si on fait :
VB:
O.Range("E2") = Format(DR, "dd/mm/yyyy")
On obtient un affichage mm/jj/aaaa
si on fait
Code:
O.Range("E2") = DR
On obtient un affichage jj/mm/aaaa
mais si on fait
Code:
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

XLDnaute Barbatruc
Repose en paix
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...
 

Discussions similaires

Membres actuellement en ligne

Aucun membre en ligne actuellement.

Statistiques des forums

Discussions
311 725
Messages
2 081 941
Membres
101 848
dernier inscrit
Djigbenou