XL 2019 Dates Anniversaires dans l'ordre

Caninge à dit:

Bonjour à 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

Cliquez pour agrandir...

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

job75 à dit:

Re, salut Jacky67,

Fichier (3) avec cette fonction VBA, très simple :

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

Boone nuit.

Cliquez pour agrandir...

​

Caninge à dit:

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

Cliquez pour agrandir...

Jacky67 à dit:

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.

Cliquez pour agrandir...

Caninge à dit:

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.

Cliquez pour agrandir...

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