البحث في الشهادات في مدى معين .. سؤال

[ناصر سعيد]

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

يجزيكم الله خيرا ويبارك فيكم ... آمين

هذا كود يعمل جيدا

ويبحث في كل الصفحه عن الشهادات المطلوبه

ولكني اريد ان يبحث في مدى معين احدده في صفحه اكسيل

لاادري عندما اضع هذا الشرط لايعمل الكود

     '   For i = SHEHADA.Range("U7").Value To SHEHADA.Range("V7").Value

======

 

 

وهذا هو الكود كاملا

Sub ثلاثة_معايير()
'   هذا الكود للنابغه ساجده العزاوي
' وهي من أهلنا بالعراق أعز الله العراق وأذل أعداءه
'تم في اكتوبر 2017
'كمعطيات المحترم ابو أحمد محمدي
'الهدف من الكود هو استخراج الشهادات
'كل 3 شهادات في صفحه واحدة
'بثلاث معايير
'=*=*=*=*=*
 Dim SHEHADA As Worksheet, DATA As Worksheet
 Dim myArray, targt, targt2, targt3 As String
 
    'اسم صفحة المصدر
    Set DATA = Worksheets("رصد الترم الثانى")
    
     'اسم صفحة الهدف
    Set SHEHADA = Worksheets("3 شهادات ب3 معايير")
'===================
    'targt = "ناج*"
   ' targt2 = "ول*"
   ' targt3 = "5/1"
     targt = SHEHADA.Range("R7").Value & "*"
    targt2 = SHEHADA.Range("S7").Value & "*"
    targt3 = SHEHADA.Range("T7").Value & "*"
'===================
c = 0
Application.ScreenUpdating = False
    lr = DATA.Cells(Rows.Count, 2).End(xlUp).Row   'اخر صف به بيانات

' عدد الصفوف الخارجة
'عن التوزيع في ورقة مصدر البيانات
  'هذا السطر في حال شهادات الكل
       For i = 7 To lr
       
       'هذا السطر في حال طلب شهادات محدده
     '   For i = SHEHADA.Range("U7").Value To SHEHADA.Range("V7").Value

    '=======
If DATA.Cells(i, 101) Like targt & "*" And DATA.Cells(i, 104) Like targt2 & "*" And DATA.Cells(i, 103) Like targt3 & "*" And c = 0 Then
     Range("M3") = DATA.Cells(i, 2)
            c = c + 1
            '===
            
   ElseIf DATA.Cells(i, 101) Like targt & "*" And DATA.Cells(i, 104) Like targt2 & "*" And DATA.Cells(i, 103) Like targt3 & "*" And c = 1 Then
     Range("M19") = DATA.Cells(i, 2)
            c = c + 1
            '===
            
   ElseIf DATA.Cells(i, 101) Like targt & "*" And DATA.Cells(i, 104) Like targt2 & "*" And DATA.Cells(i, 103) Like targt3 & "*" And c = 2 Then
     Range("M35") = DATA.Cells(i, 2)
            c = c + 1
            '===

  ' ElseIf DATA.Cells(i, 101) Like targt & "*" And DATA.Cells(i, 104) Like targt2 & "*" And DATA.Cells(i, 103) Like targt3 & "*" And c = 3 Then
    ' SHEHADA.Range("M51") = DATA.Cells(i, 2)
           ' c = c + 1
            '===
    
            End If
            
   ' If i = lr And c = 4 Then SHEHADA.Range("a1:p63").PrintOut: Exit For
    If i = lr And c = 3 Then SHEHADA.Range("a1:p47").PrintOut: Exit For
    If i = lr And c = 2 Then SHEHADA.Range("a1:p31").PrintOut: Exit For
    If i = lr And c = 1 Then SHEHADA.Range("a1:p15").PrintOut: Exit For
    If i < lr And (Range("M19") = "" Or Range("M35") = "" Or SHEHADA.Range("M51") = "") Then GoTo 1
    If i < lr And c = 3 Then SHEHADA.Range("a1:p47").PrintOut
      c = 0
     Range("M3") = ""
     Range("M19") = ""
     Range("M35") = ""
    ' Range("M51") = ""
    
1:
   Next i
     Range("M3") = ""
     Range("M19") = ""
     Range("M35") = ""
    ' Range("M51") = ""
   Application.ScreenUpdating = True
End Sub

 

وهذا هو الملف

https://up.top4top.net/downloadf-666n9v8u1-rar.html

[بن علية حاجي]

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

تم اقتراح حل في الملف المرفق مع بعض التعديلات... المشكل الوحيد أن الأكواد التي كانت في ملفك تم مسحها (لخطأ في الملف) بعدما قمت بتحميله وفتحه... لذا بنسخ الكود بالأعلى ولصقه في الملف والتعديل عليه بما يوافق طلبك...

بن علية حاجي

البحث عن الشهادات في مدى معين.rar

[ناصر سعيد]

ربنا يحفظك ويصونك استاذ بن عليه

لم استطع تشغيل الكود عندما اضغط على الزر تحدث هزه بسيطه ولايعمل

رايت في W7 و W8  كلمه محدده والرقم 2

هل تعني كلمه محدده

اننا نستطيع ان ناتي بالشهادات المحصوره بين الرقمين  7 و10

وان كلمه الكل .. تاتي بالشهادات في كل شيت المصدر

وماذا تعني الرقم 2

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

[ناصر سعيد]

للرفع

[ناصر سعيد]

يارب ارزقنا باحد الاخوه الكرام

[بن علية حاجي]

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

أخي الكريم ناصر سعيد، اعتقدت أني قدمت حلا للمسألة ولكني أدركت أن الحل ناقص لأني لم أعدّل في أوامر الطباعة في الكود وأقصد التعديل في الجزئية التالية من الكود:

   ' If i = lr And c = 4 Then SHEHADA.Range("a1:p63").PrintOut: Exit For
    If i = lr And c = 3 Then SHEHADA.Range("a1:p47").PrintOut: Exit For
    If i = lr And c = 2 Then SHEHADA.Range("a1:p31").PrintOut: Exit For
    If i = lr And c = 1 Then SHEHADA.Range("a1:p15").PrintOut: Exit For
    If i < lr And (Range("M19") = "" Or Range("M35") = "" Or SHEHADA.Range("M51") = "") Then GoTo 1
    If i < lr And c = 3 Then SHEHADA.Range("a1:p47").PrintOut

وقد تم التعديل على الكود ببعض الإضافة والتغيير في بعض الأوامر، وتجد هذه الإضافات أو هذه التغييرات في الأوامر بين سطرين من الشكل:

'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

بالنسبة للتعديل على الشيتات فربما تلاحظ أني أضفت في الخلية W8 قائمة منسدلة من كلمتين "الكل" و "محددة" تستمد عناصرها من النطاق Y1:Y2 وهذا لاختيار طباعة كل الشهادات (عند اختيار "الكل") أو طباعة شهادات محددة من...إلى (عند اختيار "محددة") وأضفت أيضا معادلة في الخلية W7 تعطي ترتيب الكلمة التي نختارها في الخلية W8 من القائمة المنسدلة (ونتائج المعادلة هي: 1 لكلمة "الكل" و 2 لكلمة "محددة") وهذه القيمة هي الشرط أضفته في الكود للحلقة FOR....NEXT... أرجو أني نجحت في تقديم بعض التوضيح...

أخوك بن علية

البحث عن الشهادات في مدى معين_1.rar

[ناصر سعيد]

ربنا يبارك فيك استاذ بن عليه .. يارب

حل ولاأروع ... وشرح ولاأسهل