الاهلاوى 2007 قام بنشر فبراير 2, 2019 قام بنشر فبراير 2, 2019 الرجاء من الاستاذ الفاضل ابراهيم الحداد او احد المشرفين او من يستطيع تعديل حساب العمر فاهلا بالمساعدة ثانية تجارى.rar
Ali Mohamed Ali قام بنشر فبراير 2, 2019 قام بنشر فبراير 2, 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("بيانات الطالبات") 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 2
العمراوى قام بنشر فبراير 2, 2019 قام بنشر فبراير 2, 2019 (معدل) اولا الف شكر على الاهتمام والرد لكن هذا كودخاص بالصف الاول ينقل البيانات من بيانات الطلبة الى الشيت لانه شيت واحد اما هنا خمس شعب وليس شعبة واحدة والامتداد مختلف حاولت تغير الامتداد ولم تفح ممكن حضرتك تجرب تم تعديل فبراير 2, 2019 بواسطه العمراوى
العمراوى قام بنشر فبراير 2, 2019 قام بنشر فبراير 2, 2019 استاذ على حضرتك نقلت نفس الملف بدون اى تعديل يعنى نفس المشكلة
Ali Mohamed Ali قام بنشر فبراير 2, 2019 قام بنشر فبراير 2, 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(ActiveSheet.Name) VlDate = ws.Range("E2").Value '---------------------------------- LR = ws.Cells(Rows.Count, "C").End(xlUp).Row ws.Range("F10:H" & LR + 1).ClearContents Set Rng = ws.Range("E10:E" & 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 3
العمراوى قام بنشر فبراير 2, 2019 قام بنشر فبراير 2, 2019 استاذ على ممكن حضرتك تجرب هذا التاريخ فى الملف اللى حضرت وضعته 1/12/2000 سوف يعطيك العمر بالسالب فى الشهور وضعت الكود المنشور ولم يعمل اعتذر للاطالة لكن نريد العمل يكون على اكمل وجه لاننا نحتاجة فى الكنترول
احمد بدره قام بنشر فبراير 2, 2019 قام بنشر فبراير 2, 2019 بعد إذن أساتذنا الأفاضل تم التعديل ثانية.rar
Ali Mohamed Ali قام بنشر فبراير 2, 2019 قام بنشر فبراير 2, 2019 اخى الكريم يمكن تكون المشكلة لديك انت فكما ترى بالصورة هذا من الملف المرسل اليك . 3
العمراوى قام بنشر فبراير 2, 2019 قام بنشر فبراير 2, 2019 (معدل) الف شكر الحمد لله الملف استاذ على تمام تقبلوا التحية والاحترام تم تعديل فبراير 2, 2019 بواسطه العمراوى
الاهلاوى 2007 قام بنشر فبراير 3, 2019 الكاتب قام بنشر فبراير 3, 2019 الف شكر لكل من ساهم فى هذا العمل بارك الله فيكم جميعا
الردود الموصى بها
انشئ حساب جديد او قم بتسجيل دخولك لتتمكن من اضافه تعليق جديد
يجب ان تكون عضوا لدينا لتتمكن من التعليق
انشئ حساب جديد
سجل حسابك الجديد لدينا في الموقع بمنتهي السهوله .
سجل حساب جديدتسجيل دخول
هل تمتلك حساب بالفعل ؟ سجل دخولك من هنا.
سجل دخولك الان