اعلن هنا
أكاديمية الصقر للتدريب
أعلن هنا
أعلن هنا
صفحتنا على الفيس بوك
أعلن هنا



أهلا وسهلا بك زائرنا الكريم في أكاديمية الصقر للتدريب، لكي تتمكن من المشاركة ومشاهدة جميع أقسام المنتدى وكافة الميزات ، يجب عليك إنشاء حساب جديد بالتسجيل بالضغط هنا أو تسجيل الدخول اضغط هنا إذا كنت عضواً .





البحث بجزء من النص وجلب كل النتائج بدالة معرفة

السلام عليكم ورحمة الله وبركاته إخواني وأحبابي في الله أقدم لكم اليوم دالة معرفة UDF وجدتها وأعجبتني وأحببت مشاركتكم ا ..



21-07-2018 08:27 صباحا
YasserKhalil
menu_open عضوية موثقة
مراقب عام
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 4000
الجنس : ذكر
تاريخ الميلاد : 1-10-1978
الدعوات : 11
يتابعهم : 0
يتابعونه : 296
قوة السمعة : 11346
الاعجاب : 4034
 offline 

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

إخواني وأحبابي في الله

أقدم لكم اليوم دالة معرفة UDF وجدتها وأعجبتني وأحببت مشاركتكم الدالة لتستفيدوا منها .. 
الدالة تقوم بالبحث عن جزء من النص المطلوب البحث عنه وتجلب كل النتائج المطلوبة ، وليتضح عمل الدالة سأقوم بوضع مثال 
بفرض أن لديك في ورقة العمل 2 مجموعة من الأسماء الكاملة ، وفي ورقة العمل 1 تريد أن تقوم بالبحث عن اسم Yasser مثلاًُ والاسم موجود في القائمة في ورقة العمل 2 ولكن كجزء من النصوص ... والمطلوب في هذه الحالة هو جلب كل الأسماء التي تحمل الاسم Yasser 

هذه صورة من ورقة العمل 2 التي تحتوي على البيانات أو الأسماء
8HA2P1TyA26JZWG

وهذه صورة للأسماء المطلوب البحث عنها ، والنتائج المتوقعة 
NBDCONO5eEWblZL

لعمل المطلوب نقوم بإدراج موديول جديد ، ونضع فيه الدالة المعرفة التالية
Function AllMatches(src As String, trg As Range) As String
    Dim cel         As Range
    Dim addr        As String

    With trg
        Set cel = .Find(What:=src, LookAt:=xlPart, After:=.Cells(.Cells.Count))
        If Not cel Is Nothing Then
            addr = cel.Address
            Do
                AllMatches = AllMatches & " | " & cel.Value
                Set cel = .Find(What:=src, LookAt:=xlPart, After:=cel)
                If cel Is Nothing Then Exit Do
            Loop Until cel.Address = addr
            AllMatches = Mid(AllMatches, 4)
        End If
    End With
End Function


ثم في ورقة العمل 1 نضع المعادلة التالية في الخلية B1 ثم نسحبها لأسفل لنحصل على النتائج المطلوبة
=AllMatches(A1,Sheet2!$A$1:$A$20)


لمشاهدة الروابط يلزمك التسجيل في أكاديمية الصقر للتدريب

أرجو أن يكون الموضوع مفيد لكم ، وأترككم في رعاية الله

كان معكم أخوكم في الله / ياسر خليل أبو البراء
 
 


أثارت هذه المشاركة إعجاب: Eslam Abdullah، السعيد الجزائري،





21-07-2018 11:14 صباحا
مشاهدة مشاركة منفردة [1]
الصقر
menu_open عضوية موثقة
مراقب عام
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 2
المشاركات : 1329
الجنس : ذكر
الدعوات : 11
يتابعهم : 0
يتابعونه : 330
قوة السمعة : 9824
الاعجاب : 2444
 offline 
look/images/icons/i1.gif البحث بجزء من النص وجلب كل النتائج بدالة معرفة

جزاكم الله خيرا يا غالى داله رائعه حقا من استاذ قدير3
ومن بعد اذنك دا تعديل بسيط للداله حتى يتم جلب النتائج فى عدة خلايا تحت بعض فى صفوف او متجاوره فى اعمده

حيث تم تزويد بارمتر ثالث لكتابة رقم نتيجة البحث المطلوبه 

Function AllMatchesss(src As String, trg As Range, r As Long) As String
    Dim cel         As Range
    Dim addr        As String
    Rowss = WorksheetFunction.CountIf(trg, "*" & src & "*")
    With trg
        Set cel = .Find(What:=src, LookAt:=xlPart, After:=.Cells(.Cells.Count))
        If Not cel Is Nothing Then
            addr = cel.Address
            Do
            a = a + 1
            If a > Rowss Then: Exit Do
            If a = r Then AllMatchesss = cel.Value: Exit Do
            Set cel = .Find(What:=src, LookAt:=xlPart, After:=cel)
            If cel Is Nothing Then Exit Do
            Loop Until a = r
        End If
    End With
End Function

تطبيق على الداله بالصوره


YoOixOLsnBDRPus
 
 
 


أثارت هذه المشاركة إعجاب: Eslam Abdullah، YasserKhalil، السعيد الجزائري،




21-07-2018 11:33 صباحا
مشاهدة مشاركة منفردة [2]
Eslam Abdullah
menu_open
خبير معتمد
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 03-10-2017
رقم العضوية : 852
المشاركات : 923
الجنس : ذكر
تاريخ الميلاد : 1-9-1995
الدعوات : 2
يتابعهم : 3
يتابعونه : 48
قوة السمعة : 5336
الاعجاب : 1517
 offline 
look/images/icons/i1.gif البحث بجزء من النص وجلب كل النتائج بدالة معرفة
دالة رائعة أستاذى الغالى ياسر
ولكن ما اعجبنى أكثر هو تعديل أستاذ حسام
ستصبح هكذا ذات افادة أهم
جزاكم الله كل خير أساتذتى الأعزاء 81

أثارت هذه المشاركة إعجاب: الصقر، YasserKhalil،




21-07-2018 12:27 مساء
مشاهدة مشاركة منفردة [3]
salim
menu_open
خبير معتمد
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 22-08-2017
رقم العضوية : 43
المشاركات : 97
الجنس : ذكر
تاريخ الميلاد : 1-5-1989
يتابعهم : 13
يتابعونه : 4
قوة السمعة : 1037
الاعجاب : 155
 offline 
look/images/icons/i1.gif البحث بجزء من النص وجلب كل النتائج بدالة معرفة
موضوع مشابه

Function Salim_Find(st, Rg As Range)
Salim_Find = "No Data"
Dim L%, k%
Dim s$
Dim R%: R = Rg.Rows.Count
st = UCase(st)
 For k = 1 To R
  L = InStr(UCase(Rg.Cells(k)), st)
   If L Then s = s & Rg.Cells(k) & ","
   Next
   If s <> "" Then Salim_Find = Mid(s, 1, Len(s) - 1)
   
End Function

 
  Capture1.PNG   تحميل png Capture1.PNG مرات التحميل :(11)
الحجم :(67.678) KB
 
  Salim_find.rar   تحميل rar مرات التحميل :(20)
الحجم :(16.03) KB


أثارت هذه المشاركة إعجاب: الصقر،




21-07-2018 03:12 مساء
مشاهدة مشاركة منفردة [4]
YasserKhalil
menu_open عضوية موثقة
مراقب عام
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 4000
الجنس : ذكر
تاريخ الميلاد : 1-10-1978
الدعوات : 11
يتابعهم : 0
يتابعونه : 296
قوة السمعة : 11346
الاعجاب : 4034
 offline 
look/images/icons/i1.gif البحث بجزء من النص وجلب كل النتائج بدالة معرفة
بارك الله فيكم إخواني الكرام .. هكذا يكون التفاعل في الموضوعات 
لقد أثريتم الموضوع وجعلتم له رونقاً بمشاركتكم المميزة
تقبلوا وافر تقديري واحترامي

أثارت هذه المشاركة إعجاب: الصقر، Eslam Abdullah، salim،






الكلمات الدلالية
البحث ، بجزء ، النص ، وجلب ، النتائج ، بدالة ، معرفة ،


 







اخلاء مسئولية: يخلى منتدى أكاديمية الصقر للتدريب مسئوليته عن اى مواضيع او مشاركات تندرج داخل الموقع ويحثكم على التواصل معنا ان كانت هناك اى إنتهاكات تتضمن اى انتهاك لحقوق الملكية الفكرية او الادبية لاى جهة - بالتواصل معنا من خلال نموذج مراسلة الإدارة .وسيتم اتخاذ الاجراءات اللازمة.
سياسة النشر: التعليقات المنشورة لا تعبر عن رأي منتدى أكاديمية الصقر للتدريب ولا نتحمل أي مسؤولية قانونية حيال ذلك ويتحمل كاتبها مسؤولية النشر.



الساعة الآن 11:35 مساء

أعلن هنا
أعلن هنا
أعلن هنا