كود استدعاء بمعيار واحد وبمعيارين

[ناصر سعيد]

ولااروع سهولة في التطبيق .. سرعه في التنفيذ

كود استدعاء للمبدع ياسر العربي

Sub ALL()
''هذا الكود للعبقري ياسر العربي حفظه الله
'' تم هذا الكود بتاريخ 8 / 10/ 2016
''الهدف من الكود هو استدعاء البيانات
''شرح الكود
''متغيرات
    Dim myArray, lr, X, targt, targt1, targt2, targtN

    Dim SERCH As Worksheet, _
    DATA As Worksheet
    '____________________________________________

    'اسم شيت قاعدة البيانات
    Set DATA = Worksheets("رصد الترم الثانى")

    'اسم الشيت الخاص بالبحث
    Set SERCH = Worksheets("كشوف الطلبه")
    '____________________________________________
    'المدى الذي سيتم مسحه في صفحه الهدف
    Range("D10:AB1000").Clear

    'المدى الذي سيتم نسخه لعدد محدد بخليه محدده
    Range("C9:AB9").AutoFill _
     Destination:=Range("C9:AB" & _
 Range("B4").Value + 8), Type:=xlFillDefault

    'اخر صف به بيانات
    lr = DATA.Cells(Rows.Count, 2).End(xlUp).Row + 2


    'مدى صفحة الهدف وهو يبدأ بعد عمود المسلسل
    'والرقم الموجود هو رقم عمود البدايه
    ' 'مسح نطاق البحث القديم
    SERCH.Range("D9:AB" & SERCH.Cells(Rows.Count, 4) _
                .End(xlUp).Row + 1).ClearContents

    'معيارين البحث
          '  targt2 = targt
    targt = "له* دور ثان في"
    targt2 = "ناجح"
    'نطاق قاعدةالبيانات
    ' صفحة المصدرالذي سيتم البحث فيه
    myArray = DATA.Range("A7:FF" & lr)
    '____________________________________________

   
   ReDim Y(1 To UBound(myArray, 1), 1 To _
   UBound(myArray, 2))
   
    For X = LBound(myArray) To _
    UBound(myArray)
        If targt = "" Then Exit Sub
        
        'هنا التعديل للمعيارين
  If myArray(X, 101) Like targt & "*" _
  Or myArray(X, 101) Like targt2 & _
  "*" Then
                rw = rw + 1
                
           'متغير ارقام
    'الاعمده المطلوب الاستدعاء منها
   'العمود التاني بعد المسلسل
          Y(rw, 1) = myArray(X, 2)
          
              'العمود الثالث بعد المسلسل
          Y(rw, 2) = myArray(X, 3)
          
              'العمود الرابع بعد المسلسل
          Y(rw, 3) = myArray(X, 13)
          
              'العمود الخامس بعد المسلسل
          Y(rw, 4) = myArray(X, 22)
          
              'العمود السادس بعد المسلسل وهكذا
          Y(rw, 5) = myArray(X, 31)
          
          Y(rw, 6) = myArray(X, 40)
          Y(rw, 7) = myArray(X, 51)
          Y(rw, 8) = myArray(X, 52)
          Y(rw, 9) = myArray(X, 82)
          Y(rw, 10) = myArray(X, 101)
          Y(rw, 11) = myArray(X, 102)
        '  Y(rw, 12) = myArray(X, 110)
         ' Y(rw, 13) = myArray(X, 111)
        End If
Next X
If rw > 0 Then SERCH.Cells(Rows.Count, 4).End(xlUp)(2, 1).Resize(rw, 13).Value = Y()
End Sub

 

الاستدعاء بطريقه ( خليفه عبد الله باقشير ) الاستاذ ياسر.rar

[ناصر سعيد]

================================================

عفوا .. عندما تقرأ الموضوع وتريد ان تشارك بمشاركه

اجعل مقاس الخط 26 

لون الخط بلون غامق

اجعل كتاباتك في وسط الصفحة

وشكرا لتفاعلكم

 

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

مشكور اخي الكريم ناصر على موضوعك هذا 

والفضل لك ايضا في تعديلك وتشكيلك للكود ليناسب احتياجاتك

زادكم الله علما وجزيت خيرا

تقبل تحياتي

[أبو أنس80]

جزاك الله بكم

الله طول عمر كل اعضاء منتدى