الاهلاوى 2007 قام بنشر فبراير 10, 2019 مشاركة قام بنشر فبراير 10, 2019 (معدل) السلام عليكم ورحمة الله وبركاته اتمنى المساعدة بكود حساب السن يكون دقيقة لاننى احتاجة بشدة المطلوب فى زرقة ا وورقة 2 تقبلوا وافر الاحترام المصنف1.xlsm تم تعديل فبراير 10, 2019 بواسطه الاهلاوى 2007 رابط هذا التعليق شارك More sharing options...
Ali Mohamed Ali قام بنشر فبراير 10, 2019 مشاركة قام بنشر فبراير 10, 2019 وعليكم السلام تفضل المصنف1.xlsm 1 رابط هذا التعليق شارك More sharing options...
العمراوى قام بنشر فبراير 10, 2019 مشاركة قام بنشر فبراير 10, 2019 (معدل) استاذ على شكرا على سرعة الاستجابة لكن ياريت تلقى نظرة على الملف وليكن او تاريخ سوف تجد اليوم 30 والمفروض والاصح هو 0وهكذا العشر تواريخ التى تليه ولو عملنا معادلة للسن سوف يكون الناتج 0 الكود موجود فى ملفات سابقة بهذه الطريقة هل يوجد كود اصح تم تعديل فبراير 10, 2019 بواسطه العمراوى رابط هذا التعليق شارك More sharing options...
Ali Mohamed Ali قام بنشر فبراير 10, 2019 مشاركة قام بنشر فبراير 10, 2019 هذه محاولة ادق بالمعادلات 2.xlsm 1 رابط هذا التعليق شارك More sharing options...
ابراهيم الحداد قام بنشر فبراير 10, 2019 مشاركة قام بنشر فبراير 10, 2019 السلام عليكم ورحمة الله تم بفضل الله تصحيح الخطأ Sub DatedIf_User() Dim ws As Worksheet, Sh As Worksheet, Mh As Worksheet Dim ShName As String, Rng As Range, C As Range Dim LR As Long, VlDate As Variant Application.ScreenUpdating = False Set ws = Sheets("ورقة1") VlDate = ws.Range("I5").Value '---------------------------------- LR = ws.Cells(Rows.Count, "E").End(xlUp).Row If LR < 8 Then Exit Sub ws.Range("I8:K" & LR + 1).ClearContents Set Rng = ws.Range("H8:H" & LR) '---------------------------------- If IsEmpty(VlDate) = True Then MsgBox "من فضلك ادخل تاريخ حساب السن" Exit Sub Else On Error Resume Next For Each C In Rng If C.Value <> "" Then YY = Year(VlDate) y = Year(C.Value) mm = Month(VlDate) m = Month(C.Value) dd = Day(VlDate) D = Day(C.Value) '----------------------- If D > dd And m > mm Then C.Offset(0, 1) = dd + 30 - D C.Offset(0, 2) = mm - m + 11 C.Offset(0, 3) = YY - y - 1 '----------------------- ElseIf D <= dd And m > mm Then C.Offset(0, 1) = dd - D C.Offset(0, 2) = mm - m + 12 C.Offset(0, 3) = YY - y - 1 '----------------------- ElseIf D > dd And m >= mm Then C.Offset(0, 1) = dd - D + 30 C.Offset(0, 2) = mm - m + 11 C.Offset(0, 3) = YY - y - 1 '----------------------- ElseIf D > dd And m < mm Then C.Offset(0, 1) = dd - D + 30 C.Offset(0, 2) = mm - m - 1 C.Offset(0, 3) = YY - y '----------------------- Else C.Offset(0, 1) = dd - D C.Offset(0, 2) = mm - m C.Offset(0, 3) = YY - y End If End If Next End If Application.ScreenUpdating = True End Sub 1 رابط هذا التعليق شارك More sharing options...
Ali Mohamed Ali قام بنشر فبراير 10, 2019 مشاركة قام بنشر فبراير 10, 2019 وعليكم السلام-احسنت استاذ ابراهيم عمل وكود ممتازان جعله الله فى ميزان حسناتك 1 رابط هذا التعليق شارك More sharing options...
ابراهيم الحداد قام بنشر فبراير 10, 2019 مشاركة قام بنشر فبراير 10, 2019 السلام عليكم ورحمة الله اخى الكريم على بارك الله فيك و اشكرك على كلماتك الرقيقة و دعمك المستمر لجميع الاعضاء 1 رابط هذا التعليق شارك More sharing options...
العمراوى قام بنشر فبراير 10, 2019 مشاركة قام بنشر فبراير 10, 2019 الف شكر استاذ ابراهيم جزاك الله كل خير رابط هذا التعليق شارك More sharing options...
الاهلاوى 2007 قام بنشر فبراير 10, 2019 الكاتب مشاركة قام بنشر فبراير 10, 2019 جزاك الله كل خير تمام كده شكرا لمجهودك استاذ ابراهيم تقبل التحية والاحترام رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.