ناصر سعيد قام بنشر نوفمبر 24, 2016 مشاركة قام بنشر نوفمبر 24, 2016 بسم الله الرحمن الرحيم احبابنا في الله هذا ملف اريد ترحيل طلاب الدور التاني وجزاكم الله كل خير ترحيل الدور التاني.rar رابط هذا التعليق شارك More sharing options...
ياسر العربى قام بنشر نوفمبر 24, 2016 مشاركة قام بنشر نوفمبر 24, 2016 تفضل اخي الكريم هل هذا ما تقصده ترحيل الدور التاني.rar 1 رابط هذا التعليق شارك More sharing options...
ناصر سعيد قام بنشر نوفمبر 24, 2016 الكاتب مشاركة قام بنشر نوفمبر 24, 2016 حفظك ربنا ورعاك خليفه العلامه عبد الله باقشير الاستاذ ياسر العربي اسرع كود شوفته رابط هذا التعليق شارك More sharing options...
ياسر العربى قام بنشر نوفمبر 24, 2016 مشاركة قام بنشر نوفمبر 24, 2016 الله يكرمك اخي ناصر تحياتي لك وما نحن الا طلاب علم وما زلنا نتعلم من اساتذتنا العظماء داخل المنتدى وخارجه تقبل تحياتي 1 رابط هذا التعليق شارك More sharing options...
ناصر سعيد قام بنشر نوفمبر 24, 2016 الكاتب مشاركة قام بنشر نوفمبر 24, 2016 هل يمكن اضافه .... الاسطر تتم بعدد الطلاب اللي موجود في خليه عدد الطلاب ؟ هانعمل معادله في خليه عدد الطلاب تجيب عدد الطلاب الذين لهم دور تان من صفحه رصد الترم التاني- رابط هذا التعليق شارك More sharing options...
ناصر سعيد قام بنشر نوفمبر 24, 2016 الكاتب مشاركة قام بنشر نوفمبر 24, 2016 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;"له* دور ثان في") رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.