كود لحساب السن في أول اكتوبر

[علي المصري]

السلام عليكم ورحمة الله وبركاته

بعد البحث وجدت دالة تقوم بعمل دالة

Datedif

ولكنها عبر محرر الاكواد

وقمت بالتعديل عليها لتكون كود يمكن استخدامه عن طريق زر في الصفحة

يوجد في المرفق الدالة الاصلية والكود بعد اجراء التعديلات

الكود كالتالي

Sub MyAge()
    Dim iYear, iMonth, iDay As Integer
    Dim dt As Date
    Dim sResult, sResult2, sResult3, rng, BirthDate As String
    
    Dim i As Integer
    For i = 2 To 22
    '2 هي اول صف به تاريخ ميلاد مطلوب حساب عمره
    '22    أخر صف به تاريخ ميلاد مطلوب حساب عمره
    
    BirthDate = Sheet1.Range("B" & i)
    rng = Sheet1.Range("c1")
    'الخلية المطلوب حساب العمر منها
    
    If Not IsDate(BirthDate) Then Exit Sub
    dt = CDate(BirthDate)
    'تحويل قيمة الخلية إلى تاريخ
    
    If dt > rng Then Exit Sub
    
    iYear = Year(dt)
    iMonth = Month(dt)
    iDay = Day(dt)
    iYear = Year(rng) - iYear
    iMonth = Month(rng) - iMonth
    iDay = Day(rng) - iDay

    If Sgn(iDay) = -1 Then
        iDay = 30 - Abs(iDay)
        iMonth = iMonth - 1
    End If

    If Sgn(iMonth) = -1 Then
        iMonth = 12 - Abs(iMonth)
        iYear = iYear - 1
    End If
    
    sResult1 = iYear
    sResult2 = iMonth
    sResult3 = iDay
   
    Sheet1.Range("d" & i) = sResult1
    Sheet1.Range("e" & i) = sResult2
    Sheet1.Range("f" & i) = sResult3
'السطر التالي يمكن حذفه اذا اردت ان يكون العمر مقسم إلى 3 خلايا
    Sheet1.Range("c" & i) = sResult1 & " Year, " & sResult1 & " Month, " & sResult3 & " Day "

Next i
End Sub

ملاحظة هامة

sheet1

دا اسم الورقة في محرر الاكواد

اذا اردت كتابة اسم الورقة كما سميتها في التبويب الخاص بها لابد ان تكتب كالتالي

Worksheets("اسم الورقة الموجود في التبويب").range(..........)

 

MyAge.rar

ويمكن استخدام الدالة

DateDif

كما يلي

ممكن تستخدم الدوال التالية

=DATEDIF(B3;$C$1;"y")

أو

=IF(B3="";"";DATEDIF(B3;$C$1;"y"))

 

لحساب السنة

=DATEDIF(B3;$C$1;"ym")

أو

=IF(B3="";"";DATEDIF(B3;$C$1;"ym"))

لحساب الشهر

=DATEDIF(B3;$C$1;"md")

أو 

=IF(B3="";"";DATEDIF(B3;$C$1;"md"))

لحساب اليوم

MyAge.rar

تم تعديل ديسمبر 23, 2017 بواسطه علي المصري
اضافة ملاحظة