XL 2019 Dates Anniversaires dans l'ordre

Caninge · 3 Avril 2021

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

job75 · 3 Avril 2021

Bonsoir Caninge,

Formule en F3 du fichier joint :

Code:

=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)));"")

A+

ChTi160 · 3 Avril 2021

Bonsoir caninge
Bonsoir job75 ,le Forum
ma version VBA toujours nul en formules Lol
bon y'a quand même le cas de :
Marie : née le 18/03/1869 qui aurait déjà du passer à la télé ou alors je l'ai Loupé Lol
Bonne fin de soirée
jean marie

job75 · 3 Avril 2021

Re, salut ChTi160,

Notez qu'au post #2 les cellules D12 D13 D17 D19 ne sont pas vides mais contiennent le texte vide "".

Si on les efface on obtient en colonne F la date du 31/12/2021.

Pour l'éviter voyez ce fichier (2) et la formule en F3 où j'ai ajouté EXP(LN(D3)) :

Code:

=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)));"")

A+

Jacky67 · 3 Avril 2021

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

Bonjour à tous
Une proposition par vba avec le code ci-dessous
Mise à jour à l'activation de la feuille "Prochains Anniversaires"
Prochaine date d'anniversaire en tête du tableau

VB:

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 · 3 Avril 2021

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.

Jacky67 · 4 Avril 2021

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.

Hello job75
Certes, très jolie

J'avais prêté attention à :
- Dates Anniversaire dans l'ordre
- Bien entendu je veux connaitre la date des personnes encore vivantes

- Dans la feuille "Prochains Anniversaires "

Bonne nuit également

job75 · 4 Avril 2021

J'ai laissé les anniversaires des personnes décédées pour qu'on voie bien ce qui se passe avec les dates de naissance antérieures à 1900.

Et si ces dates sont là c'est pour servir à quelque chose non ?

JHA · 4 Avril 2021

Bonjour à tous,

Un essai par formules

JHA

Caninge · 4 Avril 2021

Bonjour à tous, bonjour le forum,
merci pour toutes vos réponses, je vais regarder tout ça à tête reposée.
Je vous tiens au courant.
Oui Marie est décédée depuis longtemps. Effectivement elle serait sans doute passée à la télévision et serait la plus vieille personne dans le monde et peut-être l'univers. Lol
CANINGE

ChTi160 · 4 Avril 2021

Bonjour
Merci ça me rassure , enfin pas quelle soit morte , je m'en doutais ! Lol
Bonne journée
jean marie

Caninge · 6 Avril 2021

Bonjour à tous,
les fêtes de Pâques se sont bien passées ?
la solution de Jacky67 me plait bien et je l'ai adopté et adapté.
Je ne connais pas grand chose dans les macros, je voudrais dire plutôt rien. Mais j'ai quand même
démystifier le truc en modifiant la procédure (compliqué). 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

Jacky67 · 6 Avril 2021

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

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.

Caninge · 6 Avril 2021

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.

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.

Jacky67 · 6 Avril 2021

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.

Re...
L'avantage de prendre les "codename" à la place des noms de feuille est pratique.
On peut déplacer les feuilles , renommer les feuilles, sans modifier le code.
Néanmoins, avec la même façon de procéder, en exemple avec le nom de la feuille "Tableau" en Object, le code ci-dessous.
Set Fs = Sheets("Tableau") ' Fs pour feuille source
Si le code devait toujours être lancé par une procédure évènementielle ici: "Activate", With Sheets("Prochains Anniversaires") serait tout à fait inutile, puisqu'à l'activation de "Prochains Anniversaires", ce sera la feuille active.
Pour enlever les apostrophes, il est nettement préférable de traiter à la source plutôt que de bidouiller par la suite. Il faut donc savoir d'où viennent les données et comment ils sont placées sur la feuille.

Pour apprendre, ici, c'est très bien, sinon une recherche sur internet donne bien des résultats et des leçons avec tutos. Perso., c'est comme cela que j'ai fait, et que je fais encore.

Bon courage
Ps: La musique, quel instrument ?

VB:

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

XL 2019 Dates Anniversaires dans l'ordre

XLDnaute Accro

Pièces jointes

XLDnaute Barbatruc

Pièces jointes

XLDnaute Barbatruc

Pièces jointes

XLDnaute Barbatruc

Pièces jointes

XLDnaute Barbatruc

Pièces jointes

XLDnaute Barbatruc

Pièces jointes

XLDnaute Barbatruc

​

XLDnaute Barbatruc

XLDnaute Barbatruc

Pièces jointes

XLDnaute Accro

XLDnaute Barbatruc

XLDnaute Accro

Pièces jointes

XLDnaute Barbatruc

Pièces jointes

XLDnaute Accro

XLDnaute Barbatruc

Pièces jointes

Partager cette page

Statistiques des forums