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

[bahnay]

دا كود لحساب سن الطالب في أول أكتوبر 
 الكود شغال تمام لكن على الصف الاول فقط من البيانات

انا محتاج التعديل عليه ليعمل على كل الصفوف 

Sub a()
Dim st As Date
Dim ed As Date
Dim st_y As Integer
Dim st_m As Integer
Dim st_d As Integer
 Dim ed_y As Integer
Dim ed_m As Integer
Dim ed_d As Integer
Dim y As Integer
Dim m As Integer
Dim d As Integer
'------------------------------------------
st = Range("b2")
ed = Range("c1")

st_y = Year(st)
st_m = Month(st)
st_d = Day(st)
ed_y = Year(ed)
ed_m = Month(ed)
ed_d = Day(ed)
If ed_d >= st_d Then
d = ed_d - st_d
Else
d = 30 + (ed_d - st_d)
ed_m = ed_m - 1
End If
If ed_m >= st_m Then
m = ed_m - st_m
Else
m = 12 + (ed_m - st_m)
ed_y = ed_y - 1
End If
If ed_y < st_y Then MsgBox "date error": GoTo theend
y = ed_y - st_y
If d = 30 Then d = 0: m = m + 1
If m = 12 Then m = 0: y = y + 1

ActiveSheet.Range("D2") = y
ActiveSheet.Range("E2") = m
ActiveSheet.Range("F2") = d

theend:
End Sub
 

[bahnay]

دا كود لحساب سن الطالب في أول أكتوبر 
 الكود شغال تمام لكن على الصف الاول فقط من البيانات

انا محتاج التعديل عليه ليعمل على كل الصفوف 

Sub a()
Dim st As Date
Dim ed As Date
Dim st_y As Integer
Dim st_m As Integer
Dim st_d As Integer
 Dim ed_y As Integer
Dim ed_m As Integer
Dim ed_d As Integer
Dim y As Integer
Dim m As Integer
Dim d As Integer
'------------------------------------------
st = Range("b2")
ed = Range("c1")

st_y = Year(st)
st_m = Month(st)
st_d = Day(st)
ed_y = Year(ed)
ed_m = Month(ed)
ed_d = Day(ed)
If ed_d >= st_d Then
d = ed_d - st_d
Else
d = 30 + (ed_d - st_d)
ed_m = ed_m - 1
End If
If ed_m >= st_m Then
m = ed_m - st_m
Else
m = 12 + (ed_m - st_m)
ed_y = ed_y - 1
End If
If ed_y < st_y Then MsgBox "date error": GoTo theend
y = ed_y - st_y
If d = 30 Then d = 0: m = m + 1
If m = 12 Then m = 0: y = y + 1

ActiveSheet.Range("D2") = y
ActiveSheet.Range("E2") = m
ActiveSheet.Range("F2") = d

theend:
End Sub
 

school.zip

[ناصر سعيد]

محتاج التعديل عليه ليعمل على كل الصفوف 

Sub a()
Dim st As Date
Dim ed As Date
Dim st_y As Integer
Dim st_m As Integer
Dim st_d As Integer
 Dim ed_y As Integer
Dim ed_m As Integer
Dim ed_d As Integer
Dim y As Integer
Dim m As Integer
Dim d As Integer
'------------------------------------------
st = Range("b2")
ed = Range("c1")

st_y = Year(st)
st_m = Month(st)
st_d = Day(st)
ed_y = Year(ed)
ed_m = Month(ed)
ed_d = Day(ed)
If ed_d >= st_d Then
d = ed_d - st_d
Else
d = 30 + (ed_d - st_d)
ed_m = ed_m - 1
End If
If ed_m >= st_m Then
m = ed_m - st_m
Else
m = 12 + (ed_m - st_m)
ed_y = ed_y - 1
End If
If ed_y < st_y Then MsgBox "date error": GoTo theend
y = ed_y - st_y
If d = 30 Then d = 0: m = m + 1
If m = 12 Then m = 0: y = y + 1

ActiveSheet.Range("D2") = y
ActiveSheet.Range("E2") = m
ActiveSheet.Range("F2") = d

theend:
End Sub
  

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

[علي المصري]

وليه الاكواد

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

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

لحساب اليوم

 

Datedif.rar

[علي المصري]

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

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

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

 

MyAge.rar

تم تعديل ديسمبر 23, 2017 بواسطه علي المصري

[ناصر سعيد]

كود ولا اروع ... ربنا يبارك فيك

[bahnay]

استاذ على المصري 
ربنا يبارك في حضرتك هو دا اللي كنت محتاجه فعلا 
ربنا يزيدك علم ويجعله في ميزان حسناتك يارب
بالنسبة لسؤال حضرتك ليه ما استخدمتش المعادلات لأني بعمل برنامج بالفيجوال بيسك وعامل زر استيراد بيانات من الاكسيل والمعادلات بتعمل مشاكل 
علشان كده لجأت للكود 

للمرة الثانية اشكرك جدا