ترحيل طلاب

[ناصر سعيد]

بسم الله الرحمن الرحيم

احبابنا في الله

هذا ملف اريد ترحيل طلاب الدور التاني

وجزاكم الله كل خير

ترحيل الدور التاني.rar

[ياسر العربى]

تفضل اخي الكريم هل هذا ما  تقصده

ترحيل الدور التاني.rar

[ناصر سعيد]

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

اسرع كود شوفته

[ياسر العربى]

الله يكرمك اخي ناصر تحياتي لك

وما نحن الا طلاب علم وما زلنا نتعلم من اساتذتنا العظماء داخل المنتدى وخارجه

تقبل تحياتي

 

[ناصر سعيد]

هل يمكن اضافه .... الاسطر تتم بعدد الطلاب اللي موجود في خليه عدد الطلاب ؟

 

 

هانعمل معادله في خليه عدد الطلاب تجيب عدد الطلاب الذين لهم دور تان من صفحه رصد الترم التاني-

[ناصر سعيد]

Sub Yasser_Serch()
''هذا الكود للعبقري ياسر العربي حفظه الله
'' تم هذا الكود بتاريخ 8 / 10/ 2016
''الهدف من الكود هو فلترة البيانات
''شرح الكود
''
    Dim myArray, lr, X, targt, targt1, targt2, targtN
    Dim SERCH As Worksheet, DATA As Worksheet
    '____________________________________________
    Set DATA = Worksheets("رصد الترم الثانى")    'اسم شيت قاعدة البيانات
    Set SERCH = Worksheets("بيانات الطلبة (2)")    'اسم الشيت الخاص بالبحث
    '____________________________________________
    Range("A8:R1000").Clear
    Range("A7:R7").AutoFill Destination:=Range("A7:R" & Range("A4").Value + 6), Type:=xlFillDefault
    lr = DATA.Cells(Rows.Count, 2).End(xlUp).Row + 2  'اخر صف به بيانات
    SERCH.Range("B7:N" & SERCH.Cells(Rows.Count, 2).End(xlUp).Row + 1).ClearContents    'مسح نطاق البحث القديم
    targt = "له* دور ثان في"    'خلية البحث
    myArray = DATA.Range("A7:EF" & lr)     'نطاق قاعدةالبيانات الذي سيتم البحث فيه
    '____________________________________________
    ReDim Y(1 To lr, 1 To 13)
    For X = 1 To lr - 6
        If targt = "" Then Exit Sub
        If myArray(X, 101) Like targt & "*" Then
            rw = rw + 1
            'For ww = 1 To 102
              '  Y(rw, ww) = myArray(X, ww)
          '  Next ww
          Y(rw, 1) = myArray(X, 2)
          Y(rw, 2) = myArray(X, 1)
          Y(rw, 3) = myArray(X, 3)
          Y(rw, 4) = myArray(X, 109)
          Y(rw, 5) = myArray(X, 131)
          Y(rw, 6) = myArray(X, 132)
          Y(rw, 7) = myArray(X, 133)
          Y(rw, 8) = myArray(X, 134)
          Y(rw, 9) = myArray(X, 135)
          Y(rw, 10) = myArray(X, 136)
          Y(rw, 11) = myArray(X, 108)
          Y(rw, 12) = myArray(X, 110)
          Y(rw, 13) = myArray(X, 111)
        End If
Next X
If rw > 0 Then SERCH.Cells(Rows.Count, 2).End(xlUp)(2, 1).Resize(rw, 13).Value = Y()
End Sub

=COUNTIF('رصد الترم الثانى'!CW7:CW137;"له* دور ثان في")