اريد استدعاء ضمن 3 شروط

[amrhosny]

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

عندي شيت فيه اسماء موظفين وبياناتهم

المطلوب في شيت اخر

اذا كتبت شرط 1

وشرط 2

وشرط 3

يحضرلي مجموعة الأسماء من الشيت الاول ضمن الشروط دي

مرفق ملف 

شكرا جزيلا

بحث.xlsx

[سليم حاصبيا]

جرب هذا الملف

MY_search.xlsx

[amrhosny]

اكثر من رائع هذا هو المطلوب بالفعل
سلمت يداك استاذنا المبدع

انا حذفت اختيار رابع وهو الراحة

خليتهم 3 شروط فقط

تسلم ايدك والف الف شكر 

[الأستاذ / محمد الدسوقى]

مبدع دائما أستاذنا الكبير / سليم

وإثراء للموضوع يمكن تجربة الكود التالى لاستدعء البيانات بأكثر من شرط

Option Explicit
Sub M_D_Test()
Dim ws As Worksheet: Set ws = Sheets("Data")
Dim sh As Worksheet: Set sh = Sheets("المطلوب")

Dim Arr As Variant, Arr1 As Variant, Temp As Variant
Dim lr As Long, I As Long, j As Long, P As Long
lr = ws.Range("C" & Rows.Count).End(xlUp).Row
'------------------------------------
Application.ScreenUpdating = False

sh.Range("H2:H22").ClearContents
Arr = ws.Range("A2:Z" & lr).Value
     '===================
        Arr1 = Array(5)
     '====================
ReDim Temp(1 To UBound(Arr, 1) + 1, 0 To UBound(Arr1) + 1)
For I = 1 To UBound(Arr)
'          الـ 3 شروط
' ==================================================================================================
    If Arr(I, 19) = sh.[A2].Value And Arr(I, 7) = sh.[B2].Value And Arr(I, 3) = sh.[C2].Value Then
'==================================================================================================
  P = P + 1
    For j = 0 To UBound(Arr1)
    Temp(P, j) = Arr(I, Arr1(j))
  Next j
End If
  Next I
If P > 0 Then sh.Range("H2").Resize(P, UBound(Temp, 2)).Value = Temp
'------------------------------------
 Application.ScreenUpdating = True
End Sub

 

MY_search_MD.xlsm

[سليم حاصبيا]

شكراً استاذ محسن

و لي انا بهذا الشأن هذا الماكرو (عسى ان ينال الإعجاب)

Option Explicit
Sub S_H_Test_NEW()
  Dim D As Worksheet: Set D = Sheets("Data")
  Dim M As Worksheet: Set M = Sheets("المطلوب")
  Dim ARR(): ARR = Array("S", "G", "C", "H")
  Dim Obj As Object, i%, Chek%, t%

Set Obj = CreateObject("Scripting.Dictionary")

M.Range("K2").CurrentRegion.ClearContents
i = 2
    Do Until D.Range("F" & i) = vbNullString
         For t = 1 To 4
          Chek = Chek + (UCase(M.Cells(2, t)) = _
          UCase(D.Cells(i, ARR(t - 1))))
         Next
        If Chek = -4 Then _
            Obj.Add i, D.Cells(i, "F")
            i = i + 1: Chek = 0
    Loop

If Obj.Count Then _
  M.Cells(2, "k").Resize(Obj.Count) = _
  Application.Transpose(Obj.items)
 
 Set Obj = Nothing: Set D = Nothing: Set M = Nothing
 Erase ARR
End Sub

الملف من جديد

 

 

MY_search_MD_SH.xlsm

[الأستاذ / محمد الدسوقى]

دائما مبدع ونتعلم منكم الكثير 

زادكم الله علما ونفعكم بما علمك 

[amrhosny]

استاذي ماذا لو اردت اضافة شرط اخر ولكن في نفس الصف

مرفق الملف

يعني مثلا لو انا بدور في مجموعة A عن شروط معينة

ممكن في نفس الشروط دى ادور على مجموعة A  B

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

MY_search (1).xlsx