سليم حاصبيا

قارن النتائج مع هذه نسبة مئوية salim 1.xlsx

see this video https://www.youtube.com/watch?v=yP0B1sx4k1I

لا أعلم اذا كان هذا ما تريده بالضبط نسبة مئوية salim.xlsx

المعادلة هنا من نوع (معادلات الصفيف Array Formula) لا ينفع معها Enter بل بعد كتابتها يجب الضغط على(Ctrl+Shift+Enter) 1- تضغط باستمرار على زري Ctrl+Shift 2- نقرة واحدة على زر Enter 3 تحرر الزرين Ctrl+Shift

يمكن ان يساعدك هذا الملف قم اولا بالفرز النتازلي للارقام ثم استعمل الدلة داخل الملف Dergree to 99.xlsm

احفظ الملف يصيغة xlsm

ربما كان المطلوب فرز عمود salim.xlsx

عد اذن اخي علي هذا الكود (سريع جداُ لانه يستعمل adanvced filter) Option Explicit Sub filter_for_ME() With Application .ScreenUpdating = False .Calculation = xlCalculationManual End With Dim i%, k%: k = Sheets.Count Dim S_sh As Worksheet: Set S_sh = Sheets("سحب مباشر") Dim T_sh As Worksheet Dim My_Table As Range: Set My_Table = S_sh.Range("b3").CurrentRegion For i = 2 To k Set T_sh = Sheets(i) With T_sh .Range("b3").CurrentRegion.Clear .Range("q1") = "العنوان" .Range("q2") = T_sh.Name End With My_Table.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=T_sh.Range("Q1:q2"), _ CopyToRange:=T_sh.Range("b3") T_sh.Range("q1:q2").ClearContents Next With Application .ScreenUpdating = True .Calculation = xlCalculationAutomatic End With End Sub الملف مرفق salim_Adv_Fllter.xlsm

وكيف نعرف من استلم اجره

ارفع نموذجاً عما تريد

جرب هذا الملف Book1 salim.xls

1-ازالة الخلايا المدمجة من الجدول(العدو الاول لكل شيء يسمى معادلة او كود) 2- اختصار الملف الى 20 -25 صف على الاكثر(حتى لا نضيع الوقت بتدقيق الكود) 3-ازالة الالوان والزركشة التي تبهر النظر 4 -فصل ما تريد ان تقوم يتصفيته عن كامل الجدول بعامود فارغ (انشاء جدول يالمطلوب فقط) ثم عامود فارغ ثم بقية الجدول الاساسي رأس الجدول مكون من صف واحد فقط (دون دمج خلايا بين الاعمدة)/// هذا ما يسمى (الجدول الحقيقي) وذلك كي يفهم الاكسل اي جدول سوف يعمل عليه

يمكن ان يكون الحل في هذا الماكرو Option Explicit Sub RASEB_BY_Madda() If ActiveSheet.Name <> "salim (2)" Then Exit Sub Dim My_rg As Range Dim r%, c%, i%, j% Dim Arr_Word() Dim x As Boolean ReDim Arr_Word(1 To 4) Arr_Word(1) = "أقل من 30%": Arr_Word(2) = "دون المستوى": Arr_Word(3) = "غائب": Arr_Word(4) = "غ" ''''''''''''''''''''' Set My_rg = ActiveSheet.Range("b7").CurrentRegion r = My_rg.Rows.Count: c = My_rg.Columns.Count Set My_rg = My_rg.Offset(1, 1).Resize(r - 1, c - 1) My_rg.Columns(c - 1).ClearContents '======================== For i = 1 To r For j = 2 To c Step 2 If My_rg.Cells(i, 1) = vbNullString Then Exit For x = IsError(Application. _ Match(My_rg.Cells(i, j), Arr_Word, 0)) If Not x Then My_rg.Cells(i, c - 1) = "Raseb" Exit For Else My_rg.Cells(i, c - 1) = "Najeh" End If Next Next Erase Arr_Word End Sub الملف مرفق Raseb 2 _with_condition.xls

ربما كان هذا المطلوب TEST Salim.xlsx

جرب هذا الملف الماكرو Option Explicit Sub del_row() Dim i%, k% Dim st$: st = "حذف" Dim Main As Worksheet: Set Main = Sheets("البيانات") Dim Source As Worksheet: Set Source = Sheets("المحذوف") Dim lrB% If ActiveSheet.Name <> Main.Name Then Exit Sub k = Main.Range("a1").CurrentRegion.Rows.Count For i = 2 To k lrB = Source.Cells(Rows.Count, 1).End(3).Row + 1 If i > k Then Exit For If Main.Cells(i, 5) = st Then Source.Cells(lrB, 1).Resize(1, 5).Value = _ Main.Cells(i, 1).Resize(1, 5).Value Cells(i, 1).EntireRow.Delete: i = i - 1: k = k - 1 End If Next End Sub الملف مرفق ترحيل و حذف salim.xlsm

الملف بواسطة الماكرو (اسرع بكثير) الصفحة Auto_filt من هذا الملف حدث اليوم salim_macro.xlsm

يعد اذن اخي علي المعادلة التي وضعتها يا اخي علي لا تعطي سوى نتيجة واحدة من بين عدة نتائج للتوضيح هذا الملف (صفحة Salim) الملف كبير حبتين( لذا الاكسل يستغرق بعض الثواني لتنفيذ المعادلات) من الافضل استعمال الكود في مثل هذه الحالة حدث اليوم salim.xlsx

لو فرضنا ان الرقم عندك في الخلية A1 اكتب هذه المعادلة (للتقريب الى اقرب 5 نزولاُ) =FLOOR(A1,5) و هذه (للتقريب الى اقرب 5 صعوداً) =CEILING(A1,5)

طلب الي أحد الأصدقاء ان أقوم بإدراج التاريخ 29 شباط في كل السنوات الكبيسة المحددة بين عامين فكان هذا الملف (ربما يكون في ذلك إفادة للبعض) Leap years.xlsx

بعد اذن اخي شريف هذا الكود بنسخ لك الصف في اي خلية تم تحديدها (ليس من الضروري الاولى) ولا تتم عملية النسخ الا اذا كان الصف مكتملاً (من اجل اكمال تعبئة الجدول) Option Explicit Private Sub Worksheet_SelectionChange(ByVal Target As Range) Application.EnableEvents = False Dim Final_Row%, r% Dim my_rg As Range Dim Rg_to As Range: Set Rg_to = Range("i2:k2") Final_Row = Cells(Rows.Count, 1).End(3).Row Set my_rg = Range("a" & 2, "c" & Final_Row) If Not Intersect(Target, my_rg) Is Nothing _ And Target.Count = 1 Then r = Target.Row If Application.CountA(Cells(r, 1).Resize(1, 3)) = 3 Then Rg_to.ClearContents Rg_to.Value = Cells(r, 1).Resize(1, 3).Value End If End If Application.EnableEvents = True End Sub الملف مرفق نقل محتويات salim.xlsm

بالنسبة للغياب تم معالجة الامر اما بالنسبة للتقدير لم افهم ما المطلوب Raseb 2.xlsm

كل شيء ممكن انظر الى صفحة salim من هذا الملف Raseb 1.xlsm

لم افهم ما المطلوب كيف يمكن ادراج نتيجة اكثر من طالب في خلية واحدة؟؟؟(يمكن ان يفعلها الاكسل لكن ما المنطق من ذلك)

جرب هذا الملف Raseb.xlsm

اذا كنت تريدها بواسطة الماكرو =======> هذا الملف (صفحة Salim_Macro) D salim1_Macro.xlsm