اذهب الي المحتوي
أوفيسنا

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


الردود الموصى بها

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

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

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

بانه لايوجد بيانات

Sub اربعشهادات_بثلاث_معايير()
'هذا الكود للنابغه ساجده العزاوي
' وهي من أهلنا بالعراق أعز الله العراق وأذل أعداءه
'تم في اكتوبر 2017
'كمعطيات المحترم ابو أحمد محمدي
'تم التعديل على الكود لمتطلبات جديده بواسطه المحترم ذائع الصيت بن علية حادجي الجزائري
'تم بناء على متطلبات جديده في الكود
'الهدف من الكود هو استخراج الشهادات
'كل 3 شهادات في صفحه واحدة
'بثلاثة معايير
            '======================
 Dim SHEHADA As Worksheet, DATA As Worksheet
 Dim myArray, targt1, targt2, targt3 As String
 Dim X, Y, Z, U, V As Long
    'اسم صفحة المصدر
    Set DATA = Worksheets("رصد الترم الثانى")
    
     'اسم صفحة الهدف
    Set SHEHADA = Worksheets("4شهادات بثلاث معايير")
            '======================
  ' targt1 = "ناج*"
  ' targt2 = "ول*"
  ' targt3 = "5/1"
    targt1 = 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   'اخر صف به بيانات

'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  X = SHEHADA.Range("T1").Value
  Y = SHEHADA.Range("R1").Value
  Z = SHEHADA.Range("S1").Value
  U = IIf(X = 1, 7, Y)
  V = IIf(X = 1, lr, Z)

'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
'هذا السطر في حال كل الشهادات أو شهادات محددة
For i = U To V
'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    
  If DATA.Cells(i, 101) Like targt1 & "*" _
 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 targt1 & "*" _
    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 targt1 & "*" _
    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 targt1 & "*" _
    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 = V And c = 4 Then SHEHADA.Range("a1:p63").PrintOut: Exit For
 If i = V And c = 3 Then SHEHADA.Range("a1:p47").PrintOut: Exit For
 If i = V And c = 2 Then SHEHADA.Range("a1:p31").PrintOut: Exit For
 If i = V And c = 1 Then SHEHADA.Range("a1:p15").PrintOut: Exit For
 If i < V And (Range("M19") = "" Or Range("M35") = "" Or SHEHADA.Range("M51") = "") Then GoTo 1
 If i < V And c = 4 Then SHEHADA.Range("a1:P63").PrintOut
'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    c = 0
    
     SHEHADA.Range("M3") = ""
     SHEHADA.Range("M19") = ""
     SHEHADA.Range("M35") = ""
     SHEHADA.Range("M51") = ""
    
1:
   Next i
     SHEHADA.Range("M3") = ""
     SHEHADA.Range("M19") = ""
     SHEHADA.Range("M35") = ""
     SHEHADA.Range("M51") = ""
  Application.ScreenUpdating = True
End Sub

 

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

هل هذه الاسطر سليمه واين توضع في الكود ؟

   If targt1 Or targt2 Or targt3 = "" Then
     MsgBox "لايوجد طلاب  او البيانات غير مكتمله "
    Exit Sub
    End If

 

رابط هذا التعليق
شارك

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information