تعديل كود

[سماح الهياتمى]

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

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

 

فصل الناجحين والراسبين (1).rar

[سليم حاصبيا]

جرب هذا الملف

مجرد ما تختار اسم المدرسة تظهر النتيجة في صفحة تجميع

 

nageh raseb salim.rar

[ياسر خليل أبو البراء]

الأخت الفاضلة سماح

هل المطلوب في ورقة التجميع اختيار اسم المدرسة وفقط وبعدها يتم تجميع بيانات كل الطلاب سواء كان الطالب ناجح أو راسب أو غائب ..

أم المطلوب اختيار ناجح أو راسب أو غائب وبعدها اختيار المدرسة ...

أم المطلوب من التجميع اختيار المدرسة وجلب الناجحين والراسبين ، وغض النظر عن الغائبين ..

أعتقد أن المطلوب بحاجة إلى التوضيح لتتضح صورة الطلب ..

 

أخي الحبيب سليم

الكود يعمل لمرة واحدة لديك وعند اختيار مدرسة أخرى يحدث خطأ ..يرجى مراجعة الكود

تقبل تحياتي

[سليم حاصبيا]

منذ ساعه, ياسر خليل أبو البراء said:

الأخت الفاضلة سماح

هل المطلوب في ورقة التجميع اختيار اسم المدرسة وفقط وبعدها يتم تجميع بيانات كل الطلاب سواء كان الطالب ناجح أو راسب أو غائب ..

أم المطلوب اختيار ناجح أو راسب أو غائب وبعدها اختيار المدرسة ...

أم المطلوب من التجميع اختيار المدرسة وجلب الناجحين والراسبين ، وغض النظر عن الغائبين ..

أعتقد أن المطلوب بحاجة إلى التوضيح لتتضح صورة الطلب ..

 

أخي الحبيب سليم

الكود يعمل لمرة واحدة لديك وعند اختيار مدرسة أخرى يحدث خطأ ..يرجى مراجعة الكود

تقبل تحياتي

تم التعديل

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

 

تم تعديل أبريل 8, 2016 بواسطه سليم حاصبيا