اذهب الي المحتوي
أوفيسنا

تعديل فى ترحيل الناجحين والراسبين

قنديل الصياد

بواسطه قنديل الصياد
في منتدى الاكسيل Excel

 مشاركة

الردود الموصى بها

قنديل الصياد

قنديل الصياد

قام بنشر
قام بنشر

برجاء التعديل على الكنترول المرفق

تم الانتهاء من كنترول نصف العام

ومطلوب الاتى فى كنترول اخر العام

1- عمل ترحيل للناجحين والراسبين مع اضافة الغائبين مع الراسبين لجميع الصفوف من الاول للسادس

2- استخراج الاوائل لجميع الصفوف بناءا على مجموع المواد الاصلية فقط  وعمود مجموع المواد الاساسية موجود فى كشوف الرصد

اسم المستخدم : قنديل الصياد

كلمة السر :  1964

محرر الاكواد : 2014

حماية الخلايا : 1020

 

 

 


G.png

  • Like 1
رابط هذا التعليق
شارك
جمال عبد السميع

جمال عبد السميع

قام بنشر
قام بنشر

أخى العزيز ( قنديل )

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

ويمكن تطبيق ذلك من قبلك على باقى المراحل

وأعتقد الطلب الثانى من أسهل مايمكن ولو حضرتك بحثت فى أعمالى ستجد الكثير من المعادلات البسيطة لجلب العشرة الأوائل

تقبل تحيات أخيك : وأدعى لمصر وجيشها العظيم

كنترول نصف العام.rar

رابط هذا التعليق
شارك
قنديل الصياد

قنديل الصياد

قام بنشر
  • الكاتب
قام بنشر

اخى واستاذى العزيز الاستاذ / جمال

برجاء رفع الملف مرة اخرى مع التاكد من تشغيله

لانه عندما اريد فتح الملف لا يتم الفتح

شكرا لك

رابط هذا التعليق
شارك
جمال عبد السميع

جمال عبد السميع

قام بنشر
قام بنشر

أسف لأنى قمت بحذف بعض الشيتات من العمل لتخفيض حجمة ليسهل رفعة لذلك سبب هذه المشكلة

لذلك قمت بتجزئتة إلى جزئين ليسهل رفعه

 

كنترول نصف العام.part1.rar

كنترول نصف العام.part2.rar

رابط هذا التعليق
شارك
قنديل الصياد

قنديل الصياد

قام بنشر
  • الكاتب
قام بنشر

اخى العزيز

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

 

استاذى العزيز

يمكن ان ترفع الملف بدون تجزئة على هذا الرابط

 

http://www.gulfup.com/

رابط هذا التعليق
شارك
  • 2 weeks later...
قنديل الصياد

قنديل الصياد

قام بنشر
  • الكاتب
قام بنشر

مرفق ملف الكنترول وبه اكواد الترحيل لاخر العام

يرجى التعديل عليها فقط حتى تعمل بشكل صحيح

 

 

 

G.png

 

لكبر حجم الكنترول يرجى بعد التعديل رفعه على الرابط التالى

 

http://www.gulfup.com/

رابط هذا التعليق
شارك
الـعيدروس

الـعيدروس

قام بنشر
قام بنشر

الاخ الفاضل قنديل الصياد

مع كثر صفحات البرنامج

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

ارجو منك توضيح الطلب

ماهي اوراق اخر العام

هل هيا من ( صف اول اخر العام )  الى ( صف سادس اخر العام )

والتقييم الاخير للطالب مثلا صف اول من ورقة ( رصد اول اخر العام ) عمود (   النتيجة العامة للطالب )

يترحل منها الناجح الى ( ناجحون صف اول اخر العام ) والراسب الى ( راسبون صف اول اخر العام )

هذا مافهمته بعد تصفح الملف 

والسموحه منك للتأخر في الرد

رابط هذا التعليق
شارك
قنديل الصياد

قنديل الصياد

قام بنشر
  • الكاتب
قام بنشر

السلام عليكم

شكرا اخى واستاذى

الاستاذ / عباد على الاهتمام

لقد قمت بارفاق الملف بعد اخفاء بعض الصغحات

الصفحات الموجودة سيتم ترحيل الناجحين الى كشوف الناجحين والراسبين مع الغائبين الى كشوف الراسبين

 

::: المطلوب ترحيل الناجحين والراسبين كل صف على حده من الاول الى السادس بمعنى :

ترحيل من كشف رصد الصف الاول الى كشف الناجحين وكشف الراسبين للصف الاول ... وهكذا مع باقى الصفوف

الاكواد موجودة لكل الصفوف ولكن ينقص التعديل فى المدى حتى تعمل الاكواد بشكل صحيح

وشكرا لكم

مرفق الملف بعد اخفاء بعض صفحاته حتى يسهل التعامل مع الملف

 

 

G.png

رابط هذا التعليق
شارك
الـعيدروس

الـعيدروس

قام بنشر
قام بنشر (معدل)

اخي الكريم قنديل الصياد

اولا تأكد من مسميات الأوراق بعضها التسميه خاطئه

ثم الصق الكود التالي في مودويل

وإستدعيه من اوراق رصد

Private Const Rsb As String = "راسبون"
Private Const Na_h As String = "ناجحون"
Private Const Rs As String = "راسب"
Private Const Ng As String = "ناجح"
Public Sub A_Tr()
Dim Sn As Worksheet
Set Sn = ActiveSheet
With Sn
On Error Resume Next
Select Case .CodeName
       Case Is = "ورقة36"
       Cl = 77
       Case Is = "ورقة40"
       Cl = 77
       Case Is = "ورقة41"
       Cl = 68
       Case Is = "ورقة42"
       Cl = 85
       Case Is = "ورقة43"
       Cl = 85
       Case Is = "ورقة44"
       Cl = 85
End Select
En_S False
La = .Cells(.Rows.Count, 1).End(xlUp).Row
Sheets(S_Nm(.Name, "N")).Range("a14:ca1000").ClearContents
Sheets(S_Nm(.Name, "R")).Range("a14:ca1000").ClearContents
rr = 14: R2 = 14
For R = 14 To La
If .Cells(R, Cl).Value = Ng And .Cells(R, 2).Value <> "" Then
         Union(.Range(.Cells(R, 2), .Cells(R, 3)), .Range(.Cells(R, 6), .Cells(R, Cl + 2))).Copy
        Sheets(S_Nm(.Name, "N")).Range("B" & rr).PasteSpecial xlPasteValues
        Application.CutCopyMode = False
        rr = rr + 1
ElseIf (.Cells(R, Cl).Value = Rs Or .Cells(R, Cl).Value = "غ") And .Cells(R, 2) <> "" Then
         Union(.Range(.Cells(R, 2), .Cells(R, 3)), .Range(.Cells(R, 6), .Cells(R, Cl + 2))).Copy
        Sheets(S_Nm(.Name, "R")).Range("B" & R2).PasteSpecial xlPasteValues
        Application.CutCopyMode = False
        R2 = R2 + 1
End If
Next
En_S True
End With
End Sub
Private Function S_Nm(N$, i$)
Dim Sh As Worksheet
Dim Sm$
A = IIf(i = "R", Rsb, Na_h)
For Each Sh In ThisWorkbook.Worksheets
 Nm = Sh.Name
 If Mid(Nm, 1, 6) = A And Mid(Nm, 10, Len(Nm)) Like "*" & Mid(N, 5, Len(N)) Then
  Sm = Sh.Name
  Exit For
End If
Next
S_Nm = Sm
End Function
Private Function En_S(B As Boolean)
 With Application
  .Calculation = IIf(B, -4105, -4135)
  .ScreenUpdating = B
  .EnableEvents = B
 End With
End Function 

ارجو التجربه

ملاحظه شرط ناجح او راسب او غائب إعتمادً على عمود " النتيجة العامة للطالب" في أوراق الرصد

تم تعديل بواسطه عباد
رابط هذا التعليق
شارك
قنديل الصياد

قنديل الصياد

قام بنشر
  • الكاتب
قام بنشر

استاذنا العزيز شكرا لك

 

 

يوجد اكواد من الصف الاول الى السادس

وساقوم بارفاقها

المطلوب فيها هو تعديل المدى حتى يعمل الكود بشكل صحيح وليس كما اوردت حضرتك

الاكواد

الصف الاول

Sub tarheel()
'gr1
Dim LR As Integer
LR = [a10000].End(xlUp).Row
Sheets("ناجحون صف اول اخر العام").Range("a14:ca1000").ClearContents
Sheets("راسبون صف اول اخر العام").Range("a14:ca1000").ClearContents
Application.ScreenUpdating = False
X = 14: y = 15
For i = 14 To LR
    If Cells(i, 59).Value = "ناجح" And Cells(i, 2) <> "" Then
        Range("B" & i).Resize(1, 59).Copy
        Sheets("ناجحون صف اول اخر العام").Range("B" & X).PasteSpecial xlPasteValues
        Application.CutCopyMode = False
        X = X + 1
    ElseIf (Cells(i, 59).Value = "راسب" Or Cells(i, 59).Value = "غ") And Cells(i, 2) <> "" Then
        Range("B" & i).Resize(1, 59).Copy
        Sheets("راسبون صف اول اخر العام").Range("B" & y).PasteSpecial xlPasteValues
        Application.CutCopyMode = False
        y = y + 2
    End If
Next i
Application.ScreenUpdating = True

End Sub

الصف الثانى

Sub tarheel_()
'gr2
Dim LR As Integer
LR = [a10000].End(xlUp).Row
Sheets("ناجحون صف ثانى اخر العام").Range("a14:bh1000").ClearContents
Sheets("راسبون صف ثانى اخر العام").Range("a14:bh1000").ClearContents
Application.ScreenUpdating = False
X = 14: y = 15
For i = 14 To LR
    If Cells(i, 59).Value = "ناجح" And Cells(i, 2) <> "" Then
        Range("B" & i).Resize(1, 59).Copy
        Sheets("ناجحون صف ثانى اخر العام").Range("B" & X).PasteSpecial xlPasteValues
        Application.CutCopyMode = False
        X = X + 1
    ElseIf (Cells(i, 59).Value = "راسب" Or Cells(i, 59).Value = "غ") And Cells(i, 2) <> "" Then
        Range("B" & i).Resize(1, 59).Copy
        Sheets("راسبون صف ثانى اخر العام").Range("B" & y).PasteSpecial xlPasteValues
        Application.CutCopyMode = False
        y = y + 2
    End If
Next i
Application.ScreenUpdating = True
End Sub

الصف الثالث

Sub tarheel__()
''gr3
Dim LR As Integer
LR = [a10000].End(xlUp).Row
Sheets("ناجحون صف ثالث اخر العام ").Range("a14:ay1000").ClearContents
Sheets("راسبون صف ثالث اخر العام").Range("a14:ay1000").ClearContents
Application.ScreenUpdating = False
X = 14: y = 15
For i = 14 To LR
    If Cells(i, 50).Value = "ناجح" And Cells(i, 2) <> "" Then
        Range("B" & i).Resize(1, 51).Copy
        Sheets("ناجحون صف ثالث اخر العام").Range("B" & X).PasteSpecial xlPasteValues
        Application.CutCopyMode = False
        X = X + 1
    ElseIf (Cells(i, 50).Value = "راسب" Or Cells(i, 50).Value = "غ") And Cells(i, 2) <> "" Then
        Range("B" & i).Resize(1, 51).Copy
        Sheets("راسبون صف ثالث اخر العام").Range("B" & y).PasteSpecial xlPasteValues
        Application.CutCopyMode = False
        y = y + 2
    End If
Next i
Application.ScreenUpdating = True
End Sub

الصف الرابع

Sub tarheel___()
'gr4
Dim LR As Integer
LR = [a10000].End(xlUp).Row
Sheets("ناجحون صف رابع اخر العام").Range("a14:bl1000").ClearContents
Sheets("راسبون صف رابع اخر العام").Range("a14:bl1000").ClearContents
Application.ScreenUpdating = False
X = 14: y = 15
For i = 14 To LR
    If Cells(i, 63).Value = "ناجح" And Cells(i, 2) <> "" Then
        Range("B" & i).Resize(1, 63).Copy
        Sheets("ناجحون صف رابع اخر العام").Range("B" & X).PasteSpecial xlPasteValues
        Application.CutCopyMode = False
        X = X + 1
    ElseIf (Cells(i, 63).Value = "راسب" Or Cells(i, 63).Value = "غ") And Cells(i, 2) <> "" Then
        Range("B" & i).Resize(1, 63).Copy
        Sheets("راسبون صف رابع اخر العام").Range("B" & y).PasteSpecial xlPasteValues
        Application.CutCopyMode = False
        y = y + 2
    End If
Next i
Application.ScreenUpdating = True

End Sub

الصف الخامس

Sub tarheel____()
'gr5
Dim LR As Integer
LR = [a10000].End(xlUp).Row
Sheets("ناجحون صف خامس اخر العام").Range("a14:bl1000").ClearContents
Sheets("راسبون صف خامس اخر العام").Range("a14:bl1000").ClearContents
Application.ScreenUpdating = False
X = 14: y = 15
For i = 14 To LR
    If Cells(i, 63).Value = "ناجح" And Cells(i, 2) <> "" Then
        Range("B" & i).Resize(1, 63).Copy
        Sheets("ناجحون صف خامس اخر العام").Range("B" & X).PasteSpecial xlPasteValues
        Application.CutCopyMode = False
        X = X + 1
    ElseIf (Cells(i, 63).Value = "راسب" Or Cells(i, 63).Value = "غ") And Cells(i, 2) <> "" Then
        Range("B" & i).Resize(1, 63).Copy
        Sheets("راسبون صف خامس اخر العام").Range("B" & y).PasteSpecial xlPasteValues
        Application.CutCopyMode = False
        y = y + 2
    End If
Next i
Application.ScreenUpdating = True
End Sub

الصف السادس

Sub tarheel_____()
''gr6
Dim LR As Integer
LR = [a10000].End(xlUp).Row
Sheets("ناجحون صف سادس اخر العام").Range("a14:bl1000").ClearContents
Sheets("راسبون صف سادس اخر العام").Range("a14:bl1000").ClearContents
Application.ScreenUpdating = False
X = 14: y = 15
For i = 14 To LR
    If Cells(i, 63).Value = "ناجح" And Cells(i, 2) <> "" Then
        Range("B" & i).Resize(1, 63).Copy
        Sheets("ناجحون صف سادس اخر العام").Range("B" & X).PasteSpecial xlPasteValues
        Application.CutCopyMode = False
        X = X + 1
    ElseIf (Cells(i, 63).Value = "راسب" Or Cells(i, 63).Value = "غ") And Cells(i, 2) <> "" Then
        Range("B" & i).Resize(1, 63).Copy
        Sheets("راسبون صف سادس اخر العام").Range("B" & y).PasteSpecial xlPasteValues
        Application.CutCopyMode = False
        y = y + 2
    End If
Next i
Application.ScreenUpdating = True

End Sub

اريد فقط تعديل وتصحيح المدى فى هذه الاكواد السته كى تعمل بشكل صحيح وليس لغيرها

رابط هذا التعليق
شارك
أبو حنــــين

أبو حنــــين

قام بنشر
قام بنشر (معدل)

السلام عليكم

بعد اذن اخي عباد و كما ذكر سابقا كثرة الاوراق و معرفة الخلية التي يتحقق بها الشرط صعبت استيعاب الملف

هذا تعديل للكود الذي وضعته انت و هو يقوم بترحيل الناجح و الراسب صف اول

جرب هذا الكود

Sub tarheel()

'gr1
Dim LR As Integer
LR = [a10000].End(xlUp).Row
Sheets("ناجحون صف اول اخر العام").Range("a14:ca1000").ClearContents
Sheets("راسبون صف اول اخر العام").Range("a14:ca1000").ClearContents
Application.ScreenUpdating = False
With Sheets("رصد اول اخر العام")
 x = 14: y = 14:
For i = 14 To LR
    If .Cells(i, 75) = "ناجح" And .Cells(i, 2) <> "" Then
        .Range("F" & i).Resize(1, 74).Copy
Sheets("ناجحون صف اول اخر العام").Range("D" & x).PasteSpecial xlPasteValues
Sheets("ناجحون صف اول اخر العام").Range("A" & x) = x - 13
Sheets("ناجحون صف اول اخر العام").Range("b" & x) = .Range("b" & x)
Sheets("ناجحون صف اول اخر العام").Range("C" & x) = .Range("C" & x)
x = x + 1
 ElseIf (.Cells(i, 75) = "راسب" Or .Cells(i, 75) = "Û") And .Cells(i, 2) <> "" Then
        .Range("f" & i).Resize(1, 74).Copy
        Sheets("راسبون صف اول اخر العام").Range("d" & y).PasteSpecial xlPasteValues
Sheets("راسبون صف اول اخر العام").Range("A" & y) = y - 13
Sheets("راسبون صف اول اخر العام").Range("b" & y) = .Range("b" & y)
Sheets("راسبون صف اول اخر العام").Range("C" & y) = .Range("C" & y)
    y = y + 1
    End If
    
Next
Application.CutCopyMode = False
Application.ScreenUpdating = True

End With
End Sub
تم تعديل بواسطه أبو حنين
رابط هذا التعليق
شارك
قنديل الصياد

قنديل الصياد

قام بنشر
  • الكاتب
قام بنشر

شكرا اخى واستاذى العزيز

تم الترحيل فعلا

ولكن توجد مشكلة

انه يترك بعض الراسبون فى صفحة الناجحون واليك صورة من كشف الناجحون وصورة من كشف الراسبون

 

ناجحون :

iKK1P.jpg

راسبون :

XskMZ.png

رابط هذا التعليق
شارك
الـعيدروس

الـعيدروس

قام بنشر
قام بنشر

كما تفضل اخي الحبيب ابو حنين

خلية الشرط غير معروفه

 

اخي الفاضل قنديل الصياد

ارجو ان يكون تعديل الاستاذ ابو حنين ادى الغرض

او ارجو منك توضح ماهي خلية الشرط في كل ورقة رصد من اول الى سادس

لان مدى البيانات لكل رصد يختلف عن الاخر

والسلام عليكم

رابط هذا التعليق
شارك
قنديل الصياد

قنديل الصياد

قام بنشر
  • الكاتب
قام بنشر

كما تفضل اخي الحبيب ابو حنين

خلية الشرط غير معروفه

 

اخي الفاضل قنديل الصياد

ارجو ان يكون تعديل الاستاذ ابو حنين ادى الغرض

او ارجو منك توضح ماهي خلية الشرط في كل ورقة رصد من اول الى سادس

لان مدى البيانات لكل رصد يختلف عن الاخر

والسلام عليكم

اخى واستاذى الحبيب

خلية الشرط فى كل صفحة لكشف الرصد لجميع الصفوف من الاول الى السادس

يكون عمود ( النتجة العامة للطالب )

اليك اخى كود البترحيل لنصف العام وقد قام بعمله الاخ الاستاذ / رجب جاويش  ... قبل ذلك

Sub tarheel_6()
'gr6
Dim LR As Integer
LR = [a10000].End(xlUp).Row
Sheets("ناجحون سادس").Range("a14:bl1000").ClearContents
Sheets("راسبون سادس").Range("a14:bl1000").ClearContents
Application.ScreenUpdating = False
X = 14: y = 15
For i = 14 To LR
    If Cells(i, 63).Value = "ناجح" And Cells(i, 2) <> "" Then
        Range("B" & i).Resize(1, 63).Copy
        Sheets("ناجحون سادس").Range("B" & X).PasteSpecial xlPasteValues
        Application.CutCopyMode = False
        X = X + 1
    ElseIf (Cells(i, 63).Value = "راسب" Or Cells(i, 63).Value = "غ") And Cells(i, 2) <> "" Then
        Range("B" & i).Resize(1, 63).Copy
        Sheets("راسبون سادس").Range("B" & y).PasteSpecial xlPasteValues
        Application.CutCopyMode = False
        y = y + 2
    End If
Next i
Application.ScreenUpdating = True

End Sub

الكود كمثال للعمل عليه  ولك شكرى

رابط هذا التعليق
شارك
أبو حنــــين

أبو حنــــين

قام بنشر
قام بنشر (معدل)

و الله لقد اختلطت الامور

ارجو ان تبين لي العمود المعني بالشرط

انا اعتمدت على العمود     BW    هل هو صحيح ؟

تم تعديل بواسطه أبو حنين
رابط هذا التعليق
شارك
قنديل الصياد

قنديل الصياد

قام بنشر
  • الكاتب
قام بنشر

و الله لقد اختلطت الامور

ارجو ان تبين لي العمود المعني بالشرط

انا اعتمدت على العمود     BW    هل هو صحيح ؟

العمود by وليس bw

by  هو النتيجة العامة للطالب

رابط هذا التعليق
شارك
الـعيدروس

الـعيدروس

قام بنشر
قام بنشر

اخي قنديل الصياد

معادلة "  النتيجة العامة للطالب  " لنصف العام

تختلف عن معادلة "  النتيجة العامة للطالب " لاخر العام

اخر العام 

غ / ناجح / له دور ثانى

=IF(OR(CA14="غ");"غ";IF(AND(CA14>=160;SUM(K14)>=K$13;SUM(T14)>=T$13;SUM(AC14)>=AC$13;SUM(AK14)>=AK$13;SUM(AS14)>=AS$13;SUM(BB14)>=BB$13;SUM(BJ14)>=BJ$13;SUM(BS14)>=BS$13);"ناجح";"له دور ثانى"))

نصف العام

غ / ناجح / راسب

=IF(OR(BK14="غ");"غ";IF(AND(BK14>=400;SUM(J14)>=J$13;SUM(Q14)>=Q$13;SUM(X14)>=X$13;SUM(AD14)>=AD$13;SUM(AJ14)>=AJ$13;SUM(AQ14)>=AQ$13;SUM(AW14)>=AW$13;SUM(BD14)>=BD$13);"ناجح";"راسب"))

هل "  له دور ثانى " يحتسب كـ راسب ؟

رابط هذا التعليق
شارك

من فضلك سجل دخول لتتمكن من التعليق

ستتمكن من اضافه تعليقات بعد التسجيل



سجل دخولك الان
 مشاركة
الذهاب الي قائمه المواضيع

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information

  I accept