محتاج كود لاحتساب عدد الشهور من تاريخ معين

[emad80]

اقوم بدراسة الفيجول بيسك و احتاج الى كود احتساب عدد الايام او الشهور من تاريخ معين 
بحيث اقوم فى خلية بوضع تاريخ ميلاد  فيتم احتساب العمر بالشهور مرة و بالايام مرة  

[محمد هشام.]

1 ساعه مضت, emad80 said:

احتاج الى كود احتساب عدد الايام او الشهور من تاريخ معين 
بحيث اقوم فى خلية بوضع تاريخ ميلاد  فيتم احتساب العمر بالشهور مرة و بالايام مرة

جرب هدا 

في Module  ضع الدالة التالية 

Function CalculateAge(xDate As Range, Age As Boolean) As Variant
    If IsEmpty(xDate) Or Not IsDate(xDate.Value) Then
        CalculateAge = ""
    Else
        If Age Then
            CalculateAge = Date - xDate
        Else
            CalculateAge = (Year(Date) - Year(xDate)) * 12 + (Month(Date) - Month(xDate))
        End If
    End If
End Function

ضع تاريخ الميلاد في خلية معينة مثلا A2

حساب العمر بالأيام

=CalculateAge(A2, TRUE)

العمر بالشهور

=CalculateAge(A2, FALSE)

 بالمعادلات 

العمر بالأيام 
=IF(A2="", "", TODAY()-A2)

 العمر بالشهور
=IF(A2="", "", (YEAR(TODAY()) - YEAR(A2)) * 12 + (MONTH(TODAY()) - MONTH(A2)))

 

CalculateAge.xlsb

تم تعديل أكتوبر 9 بواسطه محمد هشام.

[سعيد بيرم]

استاذى الفاضل / محمد هشام

بارك الله فيكم **** ماذا لو أردنا حساب العمر بالسنوات

نرجو إضافة حاله أخرى لتحقيق ذلك بالدالة المعرفة وبالمعادلات

شكرا وجزاكم الله خيرا

[محمد هشام.]

3 ساعات مضت, عبد الرحمن أشرف said:

ماذا لو أردنا حساب العمر بالسنوات

Function CalculateAge(xDate As Range, AgeType As String) As Variant
    If IsEmpty(xDate) Or Not IsDate(xDate.Value) Then
        CalculateAge = ""
    Else
        Select Case AgeType
            Case "Days"
                CalculateAge = Date - xDate
            Case "Months"
                CalculateAge = (Year(Date) - Year(xDate)) * 12 + (Month(Date) - Month(xDate))
            Case "Years"
                CalculateAge = Year(Date) - Year(xDate)
                If Month(Date) < Month(xDate) Or (Month(Date) = Month(xDate) And Day(Date) < Day(xDate)) Then
                    CalculateAge = CalculateAge - 1
                End If
            Case Else
                CalculateAge = ""
        End Select
    End If
End Function

 

العمر بالايام
=CalculateAge(A2, "Days")

العمر بالشهور
=CalculateAge(A2, "Months")

 العمر بالسنوات
=CalculateAge(A2, "Years")

 

تحديث الدالة لتشمل حساب العمر بالايام - الشهور- السنوات وكدالك  (العمر بالسنوات، الأشهر، والأيام)

Function CalculateAge(xDate As Range, AgeType As String) As Variant
    If IsEmpty(xDate) Or Not IsDate(xDate.Value) Then
        CalculateAge = ""
    Else
    Dim todayDate As Date
    todayDate = Date
    
    Select Case AgeType
        Case "Days"
            CalculateAge = todayDate - xDate.Value
        Case "Months"
            CalculateAge = (Year(todayDate) - Year(xDate.Value)) * 12 + (Month(todayDate) - Month(xDate.Value))
        Case "Years"
            CalculateAge = Year(todayDate) - Year(xDate.Value)
            If Month(todayDate) < Month(xDate.Value) Or (Month(todayDate) = Month(xDate.Value) And _
                                                            Day(todayDate) < Day(xDate.Value)) Then
                CalculateAge = CalculateAge - 1
            End If
        Case "Full"
            Dim Years As Long, Months As Long, Days As Long
            Years = DateDiff("yyyy", xDate.Value, todayDate)
            If Month(todayDate) < Month(xDate.Value) Or (Month(todayDate) = Month(xDate.Value) And _
                                                            Day(todayDate) < Day(xDate.Value)) Then
                Years = Years - 1
            End If
            Months = Month(todayDate) - Month(xDate.Value)
            If Months < 0 Then
                Months = Months + 12
            End If
            Days = Day(todayDate) - Day(xDate.Value)
            If Days < 0 Then
                Days = Day(DateSerial(Year(todayDate), Month(todayDate), 0)) + Days
            End If
           CalculateAge = Years & " years, " & Months & " months, " & Days & " days"
        Case Else
            CalculateAge = ""
    End Select
    End If
End Function

 

لحساب العمر بالسنوات، الأشهر، والأيام
=CalculateAge(A2, "Full")

 

'============ بالمعادلات==============
 
العمر بالسنوات
=IF(A2="", "", DATEDIF(A2, TODAY(), "Y"))

 العمر بالسنوات والأشهر
=IF(A2="", "", DATEDIF(A2, TODAY(), "Y") & " Years, " & DATEDIF(A2, TODAY(), "YM") & " Months")

العمر بالسنوات والأشهر والأيام
=IF(A2="", "", DATEDIF(A2, TODAY(), "Y") & " Years, " & DATEDIF(A2, TODAY(), "YM") & " Months, " & DATEDIF(A2, TODAY(), "MD") & " Days")

 

احتساب عدد الايام او الشهور او السنوات من تاريخ معين.rar

تم تعديل أكتوبر 10 بواسطه محمد هشام.

[سعيد بيرم]

نمام الله ينور على حضرتك محمد بيك هشام

نرجو المساهمة فيما ينشر بموضوع جديد بواسطتى 

وشكرا لصاحب الموضوع الأصلى الأخ عماد ***** شكرا وجزاكم الله خيرا