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

**قنديل الصياد** · يوليو 31, 2013

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

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

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

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

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

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

كلمة السر : 1964

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

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

**جمال عبد السميع** · أغسطس 2, 2013

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

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

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

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

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

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

**قنديل الصياد** · أغسطس 2, 2013

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

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

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

شكرا لك

**جمال عبد السميع** · أغسطس 3, 2013

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

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

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

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

**قنديل الصياد** · أغسطس 3, 2013

اخى العزيز

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

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

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

http://www.gulfup.com/

**قنديل الصياد** · أغسطس 14, 2013

مرفق ملف الكنترول للتعديل

**قنديل الصياد** · أغسطس 15, 2013

مرفق ملف الكنترول للتعديل

**قنديل الصياد** · أغسطس 15, 2013

مرفق ملف الكنترول للتعديل

**قنديل الصياد** · أغسطس 15, 2013

مرفق ملف الكنترول للتعديل

**قنديل الصياد** · أغسطس 17, 2013

مرفق للتعديل

**قنديل الصياد** · أغسطس 17, 2013

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

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

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

http://www.gulfup.com/

**قنديل الصياد** · أغسطس 17, 2013

مرفق للتعديل

**الـعيدروس** · أغسطس 18, 2013

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

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

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

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

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

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

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

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

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

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

**قنديل الصياد** · أغسطس 18, 2013

السلام عليكم

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

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

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

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

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

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

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

وشكرا لكم

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

**الـعيدروس** · أغسطس 18, 2013

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

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

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

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

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

ارجو التجربه

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

تم تعديل أغسطس 18, 2013 بواسطه عباد

**قنديل الصياد** · أغسطس 18, 2013

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

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

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

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

الاكواد

الصف الاول

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

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

**أبو حنــــين** · أغسطس 18, 2013

السلام عليكم

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

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

جرب هذا الكود

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

تم تعديل أغسطس 18, 2013 بواسطه أبو حنين

**قنديل الصياد** · أغسطس 18, 2013

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

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

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

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

ناجحون :

راسبون :

**الـعيدروس** · أغسطس 18, 2013

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

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

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

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

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

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

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

**قنديل الصياد** · أغسطس 18, 2013

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

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

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

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

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

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

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

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

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

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

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

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

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

**أبو حنــــين** · أغسطس 18, 2013

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

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

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

تم تعديل أغسطس 18, 2013 بواسطه أبو حنين

**قنديل الصياد** · أغسطس 18, 2013

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

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

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

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

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

**أبو حنــــين** · أغسطس 18, 2013

السلام عليكم

العمود by لا يحتوي على كلمة ( راسب ) هناك فقط ( ناجح ) او ( غ ) او ( له دور ثاني )

**الـعيدروس** · أغسطس 18, 2013

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

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

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

اخر العام

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

=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);"ناجح";"راسب"))

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

**قنديل الصياد** · أغسطس 18, 2013

نعم اخى العزيز

الدور الثانى يحسب

ان الطالب راسب وله دور ثانى

تسجيل الدخول

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

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

قنديل الصياد

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

قنديل الصياد

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

قنديل الصياد

قنديل الصياد

قنديل الصياد

قنديل الصياد

قنديل الصياد

قنديل الصياد

قنديل الصياد

قنديل الصياد

الـعيدروس

قنديل الصياد

الـعيدروس

قنديل الصياد

أبو حنــــين

قنديل الصياد

الـعيدروس

قنديل الصياد

أبو حنــــين

قنديل الصياد

أبو حنــــين

الـعيدروس

قنديل الصياد

Join the conversation

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

تصفح الموقع

تصفح جديد الموقع

Support

Important Information