Ne pas afficher quand il y en a zéro

Bonjour,

Pour un calcul d'ancienneté, il faut afficher les années, mois et jours dans le résultat mais lorsqu'il y a "0" mois ou jour, voir année ce serait bien que cela ne les affiche pas.

Dans la pièce jointe, en "P" s'affiche le résultat du calcul et en "Q" ce que je souhaiterais qu'il s'affiche. Ligne 14 pour le premier exemple.

Les calculs se font dans les colonnes de D à O qui sont en principe cachées.

Merci

Bonjour,

Décidément tu tapes dans mes archives !

Une fonction personnalisée pour calculer l'âge :

Function AGE(dn, Optional aff As String = "a", Optional df)
    Dim d, hui, a%, m%, j%, agr$
    Application.Volatile
    On Error Resume Next
    If IsMissing(df) Then
        hui = Date
    Else
        hui = CDate(df)
        If CLng(hui) > 0 And CLng(hui) < 60 Then hui = hui + 1
        'hui = CDate(df)
    End If
    d = CDate(dn)
    If CLng(d) > 0 And CLng(d) < 60 Then d = d + 1
    'd = CDate(dn)
    If hui < d Then GoTo errdate
    On Error GoTo errdate
    a = DateDiff("yyyy", d, hui)
    If DateAdd("yyyy", a, d) > hui Then a = a - 1
    agr = a & IIf(a > 1, " ans", " an")
    If UCase(aff) = "M" Or UCase(aff) = "J" Then
        d = DateAdd("yyyy", a, d)
        m = DateDiff("m", d, hui)
        If DateAdd("m", m, d) > hui Then m = m - 1
        If m > 0 Then agr = agr & " " & m & " m."
        If UCase(aff) = "J" Then
            d = DateAdd("m", m, d)
            j = DateDiff("y", d, hui)
            If j > 0 Then agr = agr & " " & j & " j."
        End If
    End If
    AGE = agr
    Exit Function
errdate:
    AGE = CVErr(xlErrNA)
End Function

NB- Elle affichait normalement x ans 0 m. 0 j. Je viens juste d'ajouter les 2 conditions pour qu'elle ne les affiche pas si 0.

Utilisation : elle comporte 3 arguments:

• la date de naissance (obligatoire)
• l'indication optionnelle "a" pour âge en années, "m" pour âge en années et mois ou "j" pour âge en années mois et jours.

-la date à laquelle on veut calculer l'âge (optionnnel)

(si omis: calcul à la date du jour)

Dans ton utilisation, tu auras à mettre donc "J" en 2e argument et la date à laquelle apprécier l'ancienneté en 3e...

La fonction fonctionne également pour les dates avant 1900 (et travaillant en VBA rectifie naturellement l'erreur d'1 jour d'Excel avant le 1er mars 1900). Mais tu n'auras sans doute pas à remonter jusque là pour des anciennetés !

Cordialement.

Bonjour, bayard

Dans les options Excel, il y a une fonction qui supprime les zéros

dans les cellules de valeur nulles.

Voir les schémas ci-joints

Re,

Petit rectificatif d'utilisation de la fonction :

Lors du calcul de l'ancienneté, la date de fin de service est incluse dans les services, il faut donc ajouter 1 à cette date pour obtenir le bon résultat. Soit formuler (par exemple pour la ligne 14 de ton fichier) :

=AGE(B14;"j";C14+1)

Si tu mets cette formule en S14 dans ton fichier, tu tires vers le bas pour recopier et tu retrouveras les valeurs indiquées en Q.

Par ailleurs je n'ai pas prévu de supprimer an si 0 an mais tu peux rectifier facilement :

remplacer la ligne :

agr = a & IIf(a > 1, " ans", " an")

par :

If a > 0 Then agr = a & IIf(a > 1, " ans", " an")

De même si tu veux l'indication mois et jours en entier, remplacer la 1re ligne ci-dessous par la seconde :

If m > 0 Then agr = agr & " " & m & " m."

If m > 0 Then agr = agr & " " & m & " mois"

If j > 0 Then agr = agr & " " & j & " j."

If j > 0 Then agr = agr & " " & j & IIf(j > 1, " jours", " jour")

Cordialement.

Tant que j'y suis, révision complète pour ne pas avoir à mettre "J", ni +1 à la date...

Function ANCIENNETE(dn, df)
    Dim d, hui, a%, m%, j%, agr$
    Application.Volatile
    On Error Resume Next
    hui = CDate(df) + 1
    If CLng(hui) > 0 And CLng(hui) < 60 Then hui = hui + 1
    d = CDate(dn)
    If CLng(d) > 0 And CLng(d) < 60 Then d = d + 1
    If hui < d Then GoTo errdate
    On Error GoTo errdate
    a = DateDiff("yyyy", d, hui)
    If DateAdd("yyyy", a, d) > hui Then a = a - 1
    If a > 0 Then agr = a & IIf(a > 1, " ans", " an")
    d = DateAdd("yyyy", a, d)
    m = DateDiff("m", d, hui)
    If DateAdd("m", m, d) > hui Then m = m - 1
    If m > 0 Then agr = agr & " " & m & " mois"
    d = DateAdd("m", m, d)
    j = DateDiff("y", d, hui)
    If j > 0 Then agr = agr & " " & j & IIf(j > 1, " jours", " jour")
    ANCIENNETE = agr
    Exit Function
errdate:
    ANCIENNETE = CVErr(xlErrNA)
End Function

2 arguments obligatoires, les 2 dates. Et rebaptisée (pour éviter confusion, elle serait en erreur d'un jour pour le calcul d'un âge)

Illustration dans ton fichier.

Bonjour,

Bonjour MFerrand,

Une procédure dans mes archives. J'ai simplement modifié le nom de la fonction. ,

Ajouter Application.Volatile si la fonction est utilisée dans une feuille.

Cdlt.

Public Function ANCIENNETE(Date1 As Date, Date2 As Date) As String
Dim FirstDate As Long, EndDate As Long
Dim lValue As Long
Dim sYear As String, sMonth As String, sDay As String

    FirstDate = CLng(Date1): EndDate = CLng(Date2)
    If EndDate < FirstDate Then
        ANCIENNETE = "Date invalide"
        Exit Function
    End If

    lValue = Evaluate("DATEDIF(" & FirstDate & "," & EndDate & ",""y""")
    If lValue > 0 Then sYear = lValue & IIf(lValue > 1, " ans, ", " an, ")

    lValue = Evaluate("DATEDIF(" & FirstDate & "," & EndDate & ",""ym""")
    If lValue > 0 Then sMonth = lValue & " mois, "

    lValue = Evaluate("DATEDIF(" & FirstDate & "," & EndDate & ",""md""")
    If lValue > 0 Then sDay = lValue & IIf(lValue > 1, " jours", " jour")

    ANCIENNETE = sYear + sMonth + sDay
    If Right(ANCIENNETE, 2) = ", " Then ANCIENNETE = Left(ANCIENNETE, Len(ANCIENNETE) - 2)

End Function

Merci Cappe Pierre et Jean-Eric,

les modifs apportées par MFerrand ont pleinement satisfait ma demande.

Je vous remercie tout les trois