Ali Mohamed Ali

الملف ليس به أى أكواد !!!! كما انك لابد من شرح المطلوب بكل دقة على الملف

عليك بعمل ضغط للملف ثم رفعه

أخى الكريم تم التعديل لاحظ بنفسك هذا هو الكود الجديد 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

عليك برفع الملف حتى تتم المساعدة

. ثانية.rar

بارك الله فيك استاذ ابراهيم وجزاك الله كل خير مجهود ممتاز جعله الله فى ميزان حسناتك ورحم الله والديك وغفر لهم واسكنهم فسيح جناته ,الفردوس الأعلى

قد تم التعديل من قبل استاذنا الكبير ابراهيم الحداد فى المشاركة الأخرى له منا جميعا كل المحبة والإحترام 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

وعليكم السلام تفضل If.xlsx

احسنت استاذى الكريم بارك الله فيك

حدد بالضبط اخى الكريم ماذا تقصد على الملف ووضع النتائج المطلوب اظهارها ؟

هل تقصد النسب بداية من العمود J وضع ما تريده بالضبط بالمعادلات والناتج صحيحان هل انت لا تريد تقريب للكسر العشرى ولا ماذا ؟

وعليكم السلام اهلا بك اخى الكريم فى المنتدى يمكنك قراءة هذا الكتاب ونظرا لكبر حجمه فتم رفعه على موقع خارجى https://up.top4top.net/downloadf-1127xi8eh1-pdf.html

وعليكم السلام مبدع دائما استاذ عبد اللطيف بارك الله فيك برنامج رائع جعله الله فى ميزان حسناتك وغفر لك ووسع الله فى رزقك ورحم والديك واسكنهما الله فسيح جناته ووسع الله فى قبرهما وجعلهما روضة من رياض الجنة وبارك الله فى اولادك وازواجك وجعلهم ذرية صالحة

تفضل اخى الكريم هذا رابط جديد https://up.top4top.net/downloadf-1127tmc1g1-rar.html

وعليكم السلام -تفضل التوتيق1.xlsx

بالتأكيد استاذى الكريم معادلة ممتازة جعله الله فى ميزان حسناتك

بارك الله فيك استاذ سليم عمل ممتاز

تفضل الى PDF https://convertio.co/ar/pdf-csv/ وهذا الى XLS https://convertio.co/ar/xls-csv/

تفضل 2018-2019قوائم الفصول.Xls دفترالتنقيط.xlsx

.

تفضل لك ما طلبت الاول.xlsm

بارك الله فيك وجزاك الله كل خير

بارك الله فيك

تفضل لك ما طلبت القيد2.xlsm

وعليكم السلام -كيف تظهر بدون وضع معادلة لهذا العمود ؟! تفضل تعديل.xlsx