مساعدة.بالبحث عن اسم في خلية بعدة جداول , ثم أخذ قيمة خلية معينة .عند تحقق الشرط

[ابوالبراءءء]

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

يوجد بالمرفق طلب البحث عن قيمة خليه في عدة جداول ومن ثم جلب قيمة خليه معينه عند تحقق الشرط .

جربت معادله Vlookup  ولكن تعتمد على نطاق واحد فقط وليس عدة نطاقات او جداول .

http://

البحث_بشروط.rar

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

ريما كان المطلوب

الكود

Option Explicit
Sub give_data()
Dim m%, i%, x%, my_st$
Dim a As Boolean
Dim match%
x = Range("Source_tabl").Rows.Count
Dim find_range As Range

Range("Source_tabl").Offset(1, 1).ClearContents
For m = 2 To x
     my_st = Range("Source_tabl").Columns(1).Cells(m)
        If my_st = vbNullString Then Exit For
       For i = 1 To 3
           a = IsError(Application.match(my_st, Range("tabl_" & i).Columns(1), 0))
             If Not a Then
                match = Application.match(my_st, Range("tabl_" & i).Columns(1), 0)
                Set find_range = Range("tabl_" & i).Columns(1). _
                Cells(match).Offset(-match + 1, -1)
                Range("Source_tabl").Columns(2).Cells(m) = find_range.Value
                Range("Source_tabl").Columns(3).Cells(m) = Range("tabl_" & i) _
               .Columns(3).Cells(match)
                GoTo 1
            End If
        Next
1:
Next
End Sub

الملف

 

البحث_بشروط Salim.xlsm

[ابوالبراءءء]

23 ساعات مضت, سليم حاصبيا said:

ريما كان المطلوب

الكود

Option Explicit
Sub give_data()
Dim m%, i%, x%, my_st$
Dim a As Boolean
Dim match%
x = Range("Source_tabl").Rows.Count
Dim find_range As Range

Range("Source_tabl").Offset(1, 1).ClearContents
For m = 2 To x
     my_st = Range("Source_tabl").Columns(1).Cells(m)
        If my_st = vbNullString Then Exit For
       For i = 1 To 3
           a = IsError(Application.match(my_st, Range("tabl_" & i).Columns(1), 0))
             If Not a Then
                match = Application.match(my_st, Range("tabl_" & i).Columns(1), 0)
                Set find_range = Range("tabl_" & i).Columns(1). _
                Cells(match).Offset(-match + 1, -1)
                Range("Source_tabl").Columns(2).Cells(m) = find_range.Value
                Range("Source_tabl").Columns(3).Cells(m) = Range("tabl_" & i) _
               .Columns(3).Cells(match)
                GoTo 1
            End If
        Next
1:
Next
End Sub

الملف

 

البحث_بشروط Salim.xlsm

بالملي يااستاذ/ سليم

اشكرك جزيل الشكر..نعم هذا كان المطلوب 

وفقك الله واسعدك 

[ابوالبراءءء]

بعد التحية الخالصه للجميع

عزيزي: استاذ/سليم

اشكرك مرة اخرى لجهودك جعلها الله في موازين حسناتك

الكود رائع و اريد تعديل صغير وذلك بسبب بان الكود لايستأنف العمل بعد الخلايا الفارغه. بداخل جدول (Source_tabl)

 

If my_st = "" Then GoTo 1

قمت باأضافه هذا الكود  هل هو مناسب؟

من ناحية السرعه في حال ان البيانات كثيره

خالص تقديري

البحث_بشروط Salim.rar

تم تعديل مارس 5, 2018 بواسطه ابوالبراءءء
قمت بأضافه كود جديد

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

هذا الكود لمثل هذه الحالة

Option Explicit
Sub give_data_salim()
Dim m%, i%, x%, my_st$
Dim a As Boolean
Dim match%, k%: k = 1
x = Range("Source_tabl").Rows.Count
Dim find_range As Range

Range("Source_tabl").Offset(1, 1).ClearContents
For m = 2 To x
        my_st = Range("Source_tabl").Columns(1).Cells(m)
        If my_st = vbNullString Then k = k + 1: GoTo 2
       For i = 1 To 4
           a = IsError(Application.match(my_st, Range("tabl_" & i).Columns(1), 0))
             If Not a Then
                match = Application.match(my_st, Range("tabl_" & i).Columns(1), 0)
                Set find_range = Range("tabl_" & i).Columns(1). _
                Cells(match).Offset(-match + 1, -1)
                Range("Source_tabl").Columns(2).Cells(k + 1) = find_range.Value
                Range("Source_tabl").Columns(3).Cells(k + 1) = Range("tabl_" & i) _
               .Columns(3).Cells(match)
                k = k + 1
               GoTo 2
            End If
       Next
2:
Next
End Sub

 

[ابوالبراءءء]

بارك الله فيك