سليم حاصبيا

جرب هذه المعادلة (تستطيع وضعها اينما تريد و السحب نزولاً ) =SMALL({18,20,22,24,26},INT(MOD(ROWS($A$1:A1)-1,5))+1)

اخي ياسر لا افهم لماذا تصر دائماً على تحميل مشاركاتك عبر هذا الموقع الذي يكرر اعلاناته اكثر من 5 مرات احياناً و في كل مرة صفحة جديدة وانتظر 10 ثواني,كل ذلك يحدث بشكل ممل اليس هناك من حل اخر

ربما يكون المطلوب (تم حماية المعادلات لعدم العبث بها عن طرق الخطأ) رفع المكرر من الجدولsalim.rar

ما هو معيار النجاح

تم اضافة ماكرو الى الصفحة لتعمل كما تريد القرية1 Salim_macro.rar

انا جربت الكود عندي و هو يعمل 100%

اليك مبدئياً الحل بواسطة المعادلات (مع وجود الخلايا المدمجة) انظر الى الصفحة الثانية من الملف القرية1 salim.rar

ارفع لك الكود مع الملف جاهزاً الملف 2003 (حسب مشاركتك به) ترتيب البيانات بشروط 2003.rar

هناك مشكلة المشاكل وهي الخلايا المدمجة (رتب الجدول دونها و سأعمل على الحل)

جرب هذا الكود (لنتفيذ الكود بشكل صحيح يجب الا تكون هناك اي خلية فارغة بالجدول باي صف من الصفوف) Sub Salim_Sort() Dim sh As Worksheet: Dim lr As Integer Set sh = ActiveWorkbook.Worksheets("البيانات") lr = sh.Cells(Rows.Count, 1).End(3).Row sh.Range("A8").Select With sh.Sort.SortFields .Clear .Add Key:=Range( _ "E8:E" & lr), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _ xlSortNormal .Add Key:=Range( _ "F8:F" & lr), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _ xlSortNormal .Add Key:=Range( _ "G8:G" & lr), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _ xlSortNormal .Add Key:=Range( _ "H8:H" & lr), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _ xlSortNormal .Add Key:=Range( _ "I8:I" & lr), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _ xlSortNormal .Add Key:=Range( _ "J8:J" & lr), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _ xlSortNormal .Add Key:=Range( _ "L8:L" & lr), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _ xlSortNormal End With With sh.Sort .SetRange Range("A7:L" & lr) .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With End Sub

جرب هذا الحل السؤال كاملا salim.rar

جرب هذا الملف المصنف1 Salim.rar

ربما يكون المطلوب الترحيل افقي salim.rar

ضع الكود بهذا الشكل Sub My_formula() For i = 1 To Sheets.Count Sheets(i).Range("e3").FormulaR1C1 = "=IFERROR(IF(ISERROR(MATCH(R2C5,C3,0)),INDEX(C3,MATCH(""*""&R2C5&""*"",C2,0)),INDEX(C2,MATCH(R2C5,C3,0))),"" "")" Next End Sub

الكود المطلوب Sub My_formula() Range("e3").FormulaR1C1 = "=IFERROR(IF(ISERROR(MATCH(R2C5,C3,0)),INDEX(C3,MATCH(""*""&R2C5&""*"",C2,0)),INDEX(C2,MATCH(R2C5,C3,0))),"" "")" End Sub

عودة ميمونة اخي عبدالله اشتقنا الى اعمالك و ابتكاراتك

تم التعديل Sub tajmi33() Dim sh1, sh2 As Worksheet Dim Rg_N, Rg_R As Range Dim lr1, lr2 As Integer Dim My_school As String Application.ScreenUpdating = False Set Rg_N = Nothing: Set Rg_R = Nothing Set sh1 = natija: Set sh2 = tajmi3 My_school = sh2.Range("e4").Value lr1 = sh1.Cells(Rows.Count, 4).End(3).Row lr2 = sh2.Cells(Rows.Count, 4).End(3).Row If lr2 < 9 Then lr2 = 9 tajmi3.Range("d9:ac" & lr2).ClearContents sh1.Select For i = 7 To lr1 If sh1.Range("e" & i) = My_school And sh1.Range("AC" & i) = "ناجح" Then If Rg_N Is Nothing Then Set Rg_N = sh1.Range(Cells(i, "d"), sh1.Cells(i, "ac")) Else Set Rg_N = Union(sh1.Range(Cells(i, "d"), sh1.Cells(i, "ac")), Rg_N) End If End If Next If Not Rg_N Is Nothing Then Rg_N.Copy sh2.Range("d9") End If For i = 7 To lr1 If sh1.Range("e" & i) = My_school And sh1.Range("AC" & i) = "راسب" Then If Rg_R Is Nothing Then Set Rg_R = sh1.Range(Cells(i, "d"), Cells(i, "ac")) Else Set Rg_R = Union(sh1.Range(Cells(i, "d"), Cells(i, "ac")), Rg_R) End If End If Next newlr = sh2.Cells(Rows.Count, 4).End(3).Row + 1 If Not Rg_R Is Nothing Then Rg_R.Copy sh2.Range("d" & newlr) End If sh2.Select Application.ScreenUpdating = True End Sub

المعادلة المطلوبة في D4 والسحب نزولاً =IF($B4<>"",SUMIF(السجل!$D$4:$D$100,$B4,السجل!$F$4:$F$100),"")

جرب هذا الملف مجرد ما تختار اسم المدرسة تظهر النتيجة في صفحة تجميع nageh raseb salim.rar

اخي علي بدل هذا الكود الطويل جداً الملي بالشروط و الاستنتاجات اقترح علبك هذا الكود البسيط (جربه ولن نتدم) لانه لا يفرق بين الحرف الصغير a و الحرف الكبير A Sub DoMyOrder() Dim R As Integer Application.ScreenUpdating = False Sheets("Sheet1").Range("i2:l31").ClearContents For R = 2 To 31 For t = 2 To 5 With Sheets("Sheet1") Select Case UCase(.Cells(R, t).Value) Case "A" .Cells(R, t + 7) = 90 Case "B" .Cells(R, t + 7) = 80 Case "C" .Cells(R, t + 7) = 70 Case "D" .Cells(R, t + 7) = 60 Case "E" .Cells(R, t + 7) = 50 Case Else .Cells(R, t + 7) = "" End Select End With Next Next Application.ScreenUpdating = True End Sub

احي علي استعمل المعادلة هذه في الخليةI2 و اسحب يساراً و نزولاً, و بلاش الكود =VLOOKUP(B2,{"A",90;"B",80;"C",70;"D",60;"E",50},2,0)

ربما يكون هذا ما تريد talween.rar

تفضل المطلوب تغيير في بعض المعادلات salim.rar

جرب هذا الملف نقل مجموع salim.rar

انسخ هذه المعادلة الى H7 ,و اسحب يمينا حتى AM7 =IF((AND(OFFSET(H3,,-1)<>"x",H3="x",OFFSET(H3,,1)<>"X")*1)=1,MAX($G13:G13)+1,"") ثم في اي مكان تريد اكتب هذه المعادلة =MAX($H$7:$AM$7)