ترحيل درجات الطلاب في الفصل

[خيماوي كووول]

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

 

ملف اكسل يحتوي على درجات الطلاب خلال الفصل ( التقويم والاختبار والمؤجل والفصل )

1ـ اريد زر كود لترحيل كل مادة على حدى ...

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

 

 

ملاحظة .. قمت بالتجربة ... ولكن يعطني المعطيات خطأ .. في بعض الاحيان الراسب ناجح .. والناجح الراسب .. ويقوم بجلب البيانات ناقصة عدد الطلاب 26 ...

 

علماً بأن الرنج عند من 1 ـ 40

94f1.rar

[خيماوي كووول]

الشيت 94 المصدر .... والشيت TN و TR  المستورد ... والاعمدة مختلفة من المصدر ... الى المستورد ... هل تكمن المشكلة بذلك ... أي يعني شرط ان تكون نفس الاعمدة في كليهما ..

[خيماوي كووول]

السلام عليكم ... لماذا لا يقوم الكود بترحيل البيانات حسب الشرط ..  ناجح او راسب ولماذا لا يبدا القراءة من الرينج المطلوب من 3 الى 40 في الصفحة 94 .. وايضا يقوم عند النسخ واللصق في الصفحات المطلوبة يقوم بتقليص عدد الطلاب الى 22 طالب ناجح و  2 رسوب ... مع ان عدد الطلاب 26 ...

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

جرب هذا الكود ..قمت ببعض التعديلات

Sub TarheelTRTN()
'''  متغيرات بعدد الصفحات المطلوب الترحيل اليها
Dim R As Integer, TR As Long, TN As Integer
Dim multipleRange As Range

          '''  أسماء الصفحات المطلوب الترحيل اليها والمدى المطلوب مسح البيانات الثديمة منه
    Sheets("TN").Range("C7:K41").ClearContents
    Sheets("TR").Range("C7:K40").ClearContents
    
        '''  عدد الصفوف العليا في الصفحات المنقول اليها البيانات
    TR = 7: TN = 7
    Application.ScreenUpdating = False
    With Sheets("94")
          '''  بداية ونهاية صفوف الورقة المصدر
    For R = 3 To 36
    
   '''''''''''''''''''''''''''''''''''''''''''''''''''''
   
                ''' رقم عمود المعيار وكلمة المعيار
        If Cells(R, 85) = "ناجح" Then
            Set multipleRange = Union(Range("I" & R), Range("O" & R), Range("S" & R), Range("W" & R), Range("AA" & R), Range("AE" & R), Range("AI" & R), Range("AM" & R), Range("AQ" & R))
            multipleRange.Copy
                  '''  سيتم اللصق في هذا الشيت
            Sheets("TN").Range("C" & TR).PasteSpecial xlPasteValues
            Application.CutCopyMode = False
            TR = TR + 1
            
              End If
        
           
   ''''''''''''''''''''''''''''''''''''''''''''''''''''
   ''' رقم عمود المعيار وكلمة المعيار
        If Cells(R, 85) = "دور ثاني" Then
            Set multipleRange = Union(Range("I" & R), Range("O" & R), Range("S" & R), Range("W" & R), Range("AA" & R), Range("AE" & R), Range("AI" & R), Range("AM" & R), Range("AQ" & R))
            multipleRange.Copy
            
                  '''  سيتم اللصق في هذا الشيت
            Sheets("TR").Range("C" & TN).PasteSpecial xlPasteValues
            Application.CutCopyMode = False
            TN = TN + 1
            
            End If
        
           
   ''''''''''''''''''''''''''''''''''''''''''''''''''''
   
    Next
  

    MsgBox ("الحمد لله تـــم الترحيل بنجاح إلى أوراق عمل جديدة ")
    Application.ScreenUpdating = True
    End With
End Sub
     

تم تعديل ديسمبر 12, 2014 بواسطه YasserKhalil

[خيماوي كووول]

اشكرك جزيل الشكر والامتنان ... الله يحفظك ..

فعلا هذا هو المطلوب ... يا استاذي العزيز

[خيماوي كووول]

هل بالامكان ان اعمل زر واحد فقط افرغ فيه البيانات جميع الصفحات حسب الرنج المطلوب لكل صفحة ..

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

الأخ الحبيب

أنا لا أمانع ، ولكن الملف يحتاج إلى مزيد من التنظيم والترتيب ، حتى يسهل العمل عليه ..وحتى يكون مريحا لك..

بالنسبة لطبك كن أكثر تحديدا وتفصيلا للطلب حتى يمكن مساعدتك (أي صفحات تريد تفريغها واذكر النطاق المراد تفريغه..

أعتقد موضوع التفريغ موضوع بسيط جدا ..

إنك تحدد الورقة المراد تفريغها والنطاق ثم الأمر ClearContents

مثلا الورقة لو اسمها Data وتريد تفريغ النطاق A1:C100

يكون الأمر في منتهى السهولة

Sheets("Data").Range("A1:C100").ClearContents

[جلال محمد]

اخي ياسر 

السلام عليكم 

جزاك الله خيرا علي تقديم المعلومة بكل بساطة

جعلة الله في موازين حسناتك