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

[amgaddvd]

السلام عليكم ورحمة الله وبركاته

 

تحية طيبة لكل الناس الافاضل فى المنتدى

 

 

طلب بسيط من سيادتكم

 

اريط عزل الراسبين فى شيت راسب وعزل الناجحين فى شيت ناجح ..

 

ومعرفة الطريقة ان  امكن ولكم جزيل الشكر

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

هذا مثال عما تريد

ان الملف يعمل بطريقتين

طريقة المعادلات و طريقة الكود

طريقة المعادلات تظهر الياً عند كتابة التنيجة في الصفحة الرئيسية الى صفحتي ناجح راسب

و طرقة الاكود تفرز لك النجين و الراسبين الى صفحتي Nageh / rasseb 

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

ناجح راسب salim 1 2003.rar

[amgaddvd]

اشكرك اخى الغالى على التجاوب السريع واريد من حضرتك عزل الراسبين فى هذا الشيت وعارف انى بتقل عليك يا بشمهندس سليمBook1.rar

 

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

اليك هذا الملف

عسى ان يكون المطلوب

ترحيل ناجح راسب.rar

[amgaddvd]

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

[amgaddvd]

كنت عايز منك يا بشمهندس كود ترحيل الشيت ده ..واتمنى لك دوام التقدم وتحقيق كل الطموحات

[amgaddvd]

ولاحظت اخى العزيز ان فى طلبة راسبين فى بعض المواد وحاصلي على اعلى من 160 ..وعايز شكل شيت الراسبين او الناجحين يكون بنفس شكل الشيت كامل

هكذا ..وانا عارف انى بتقل على حضرتك ..ربنا يخليك يا هندسة

Book1.rar

[amgaddvd]

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

[سـامي 169]

Option Explicit

Sub nageh_SALIM()

    Dim Dico, D, k
    Dim C As Range, Rng As Range
    Dim B As Long, I As Long
    Dim MyVal As Range
   Dim lrc As Integer, lrcq As Integer _
   , lrb As Integer, m As Integer
   Dim lra As Integer
   

lrc = Sheets("الشيت كامل").Cells(Rows.Count, "c").End(xlUp).Row
    Set Rng = Sheets("الشيت كامل").Range("c13:c" & lrc)

lrcq = Sheets("الشيت كامل").Cells(Rows.Count, "cq").End(xlUp).Row
   Set MyVal = Sheets("الشيت كامل").Range("cq13:cq" & lrcq)


lrb = Sheets("ناجح").Cells(Rows.Count, "b").End(xlUp).Row
    Sheets("ناجح").Range("B2:B" & lrb).ClearContents
    lra = Sheets("ناجح").Cells(Rows.Count, "a").End(xlUp).Row
    Sheets("ناجح").Range("a2:a" & lra).ClearContents

    Set Dico = CreateObject("Scripting.Dictionary")
    For I = 13 To lrcq

If Sheets("الشيت كامل").Range("cq" & I) >= 160 Then
        If Not Dico.Exists(Sheets("الشيت كامل") _
        .Range("c" & I)) Then Dico.Add Sheets("الشيت كامل") _
        .Range("c" & I).Value, Sheets("الشيت كامل").Range("cq" & I).Value
        End If
    Next I

    B = 2
    m = 2
    For Each D In Dico.items
       Sheets("ناجح").Range("b" & B) = D
        B = B + 1
    Next D
    For Each k In Dico.Keys
       Sheets("ناجح").Range("a" & m) = k
        m = m + 1
    Next k
   
   Sheets("ناجح").Columns("a:b").Font.Size = 18
   Sheets("ناجح").Columns("a:b").AutoFit
End Sub

كود مفيد جزاك الله خيرا استاذ سليم حاصبيا

ولكن نريد ان يتم استدعاء ايضا اعمدة معينه اخرى ماذا نفعل ؟

تم تعديل يونيو 1, 2015 بواسطه سـامي 169

[amgaddvd]

الا يوجد رد من عباقرة المنتدى