=SIERREUR(DATE(ANNEE(AUJOURDHUI())+(AUJOURDHUI()>DATE(ANNEE(AUJOURDHUI());SIERREUR(MOIS(D3);STXT(D3;4;2));SIERREUR(JOUR(D3);GAUCHE(D3;2))));SIERREUR(MOIS(D3);STXT(D3;4;2));SIERREUR(JOUR(D3);GAUCHE(D3;2)));"")
=SIERREUR(DATE(ANNEE(AUJOURDHUI())+(AUJOURDHUI()>DATE(ANNEE(AUJOURDHUI());SIERREUR(MOIS(EXP(LN(D3)));STXT(D3;4;2));SIERREUR(JOUR(D3);GAUCHE(D3;2))));SIERREUR(MOIS(D3);STXT(D3;4;2));SIERREUR(JOUR(D3);GAUCHE(D3;2)));"")
Bonjour à tousBonjour à tous,
Mon exemple est un extrait d'un arbre généalogique, Il y a une multitude de dates de naissances, baptêmes, décès...
(A partir de deux colonnes (Personnes + dates)
J'aimerais bien connaître les prochains anniversaires à partir de la date actuelle.
Bien entendu je veux connaitre la date des personnes encore vivantes.
Dans la feuille "Prochains Anniversaires "
Sur la première ligne : Louise va avoir 38 ans le 28 Avril 2021 et ainsi de suite pour tous les autres.
J'en appelle à vos talents exceptionnels d'utilisateurs d'Excel
CANINGE
Private Sub Worksheet_Activate()
Dim C As Range, lig&
Application.ScreenUpdating = False
lig = 4
Range("d4:g" & Rows.Count).ClearContents
For Each C In Feuil1.Range("c4.c" & Feuil1.Cells(Feuil1.Rows.Count, "c").End(xlUp).Row)
If C.Offset(, 1) <> "" And C.Offset(, 2) = "" Then
Cells(lig, "d") = C & " aura"
Cells(lig, "e") = Year(Date) - Year(C.Offset(, 1))
Cells(lig, "f") = "ans le"
Cells(lig, "g") = DateSerial(Year(Date), Month(C.Offset(, 1)), Day(C.Offset(, 1)))
lig = lig + 1
End If
Next
Range("d4").CurrentRegion.Sort key1:=[g4], Order1:=xlAscending, Header:=xlNo
End Sub
Function Anniversaire(naissance)
If Not IsDate(naissance) Then Anniversaire = "": Exit Function
Anniversaire = DateSerial(Year(Date), Month(naissance), Day(naissance))
If Date > Anniversaire Then Anniversaire = DateAdd("yyyy", 1, Anniversaire)
End Function
Hello job75Re, salut Jacky67,
Fichier (3) avec cette fonction VBA, très simple :
Boone nuit.VB:Function Anniversaire(naissance) If Not IsDate(naissance) Then Anniversaire = "": Exit Function Anniversaire = DateSerial(Year(Date), Month(naissance), Day(naissance)) If Date > Anniversaire Then Anniversaire = DateAdd("yyyy", 1, Anniversaire) End Function
Re...J'aimerais bien que l'on me dise si c'est bon. Apparemment ça marche. Une autre chose : comment la macro reconnait qu'il faut prendre les données dans la feuille Tableau et non dans une autre ?
Je vais avoir 64 ans à la fin de l'année. j'ai remarqué que certains de mes ancêtres vivaient vieux. J'ai peut-être encore le temps d'apprendre les macros. LOL
A plus
Bonjour Jacky,Re...
Oui, la modification est bonne
L'instruction qui reconnait la plage à traiter est
Feuil1.Range("d3.d" & Feuil1.Cells(Feuil1.Rows.Count, "d").End(xlUp).Row)
Prend en compte de D3 à la dernière cellule saisie de la colonne D
Il y a des apostrophes dans certaines cellules en colonne D, elles sont comprises dans cette plage
Feuil1 étant le Codename de la feuille "Tableau"
Dans la pj j'ai mis un msgbox pour voir la plage qui est prise en compte. La mfc (facultative)est modifiée.
Il n'y a pas d'âge pour apprendre et, 64, c'est encore bien jeune
Regarde, moi, éternel apprenti.
Re...Bonjour Jacky,
J'aimerais bien enlever les apostrophes et mettre directement le nom des feuilles "Tableau" et "Prochains anniversaires) dans la macro. Les noms inscrits dans ce tableau proviennent grâce à une formule d'une autre feuille et cela risque de poser des problèmes. Au fait où peut-on apprendre la programmation EXCEL ? puisque que je ne suis pas trop vieux. J'ai bien commencé la musique à 39 ans.
Private Sub Worksheet_Activate()
Dim C As Range, lig&, Fs As Worksheet
Application.ScreenUpdating = False
lig = 4
Set Fs = Sheets("Tableau")
With Sheets("Prochains Anniversaires")
.Range("d4:g" & Rows.Count).ClearContents
For Each C In Fs.Range("d3.d" & Fs.Cells(Fs.Rows.Count, "d").End(xlUp).Row)
If C.Offset(, 17) <> "" And C.Offset(, 23) = "" Then
.Cells(lig, "d") = C & " aura"
.Cells(lig, "e") = Year(Date) - Year(C.Offset(, 17))
.Cells(lig, "f") = "ans le"
.Cells(lig, "g") = DateSerial(Year(Date), Month(C.Offset(, 17)), Day(C.Offset(, 17)))
lig = lig + 1
End If
Next
.Range("d4").CurrentRegion.Sort key1:=.[g4], Order1:=xlAscending, Header:=xlNo
End With
End Sub