بحث متقدم - سرعة عالية ومرونة باستخدام المصفوفات

[ياسر خليل أبو البراء]

الشرح المستفيض لكود البحث المتقدم باستخدام المصفوفات للأستاذ الكبير ياسر العربي Search Using Arrays
http://adf.ly/1efc1m

[جمال جبريل]

طول عمرك مبدع يا ياسر عرابي 
اريد فقط ان يبحث عن الاسم الاول او الوسط او الاخير ، ولا اتقيد بالاسم الاول فقط ، يعني البحث في الاسم او اسم الاب او الجد او الاسم الاخير دون التقيدم بالاسم الاول فقط

[ياسر العربى]

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

 

If myArray(X, targtN) Like targt & "*" Then
يتم تغيير الى 
If myArray(X, targtN) Like "*" & targt & "*" Then

[نايف - م]

 السلام عليكم

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

تكست بوكس للبحث و ليست بوكس لعرض النتائج

[ياسر العربى]

تفضل اخي نايف

 

 

listbox.rar

[عاطف عبد العليم محمد]

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

وفقك الله أخ ياسر العربي  وجزاك الله خيرا 

 

[مختار حسين محمود]

1 ساعه مضت, عاطف عبد العليم محمد said:

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

وفقك الله أخ ياسر العربي  وجزاك الله خيرا 

كود روعة يا ابو العربى  خاصة مع استخدام المصفوفات   تحياتى

[ياسر العربى]

2 دقائق مضت, مختار حسين محمود said:

كود روعة يا ابو العربى  خاصة مع استخدام المصفوفات   تحياتى

انت الاروع استاذ مختار حسين خاصةمع تعليقك
 

تقبل تحياتي

[نايف - م]

كود جميل و مفيد

شكرا

[ياسر خليل أبو البراء]

أخي الحبيب ياسر العربي ..

يبدو أن الأخوة لم يجربوا الملف بشكل جيد أو لربما أكون مخطيء ..

راجع هذا السطر ففيه خطأ يتسبب في عدم عمل الكود بشكل صحيح

    targtN = Application.WorksheetFunction.Match(ComboBox1.Text, SERCH.Range("A3:J3"), 0) + 1  'دالة لايجاد رقم عمود البحث

لما الرقم 1 .لأن الرقم 1 سيزيد من رقم العمود بمقدار واحد ويجلب العمود التالي له ؟!

أمر آخر وهو الأهم أنك لم تستخدم هذا المتغير في عمود البحث ..لاحظ السطر التالي

If myArray(X, 1) Like targt & "*" Then

لاحظ استخدام الرقم 1 بدلاً من المتغير targtN ، وهذا سيجعل البحث محصوراً في العمود الأول فقط ..

تقبل تحياتي

[ياسر العربى]

21 دقائق مضت, ياسر خليل أبو البراء said:

أخي الحبيب ياسر العربي ..

يبدو أن الأخوة لم يجربوا الملف بشكل جيد أو لربما أكون مخطيء ..

راجع هذا السطر ففيه خطأ يتسبب في عدم عمل الكود بشكل صحيح

    targtN = Application.WorksheetFunction.Match(ComboBox1.Text, SERCH.Range("A3:J3"), 0) + 1  'دالة لايجاد رقم عمود البحث

لما الرقم 1 .لأن الرقم 1 سيزيد من رقم العمود بمقدار واحد ويجلب العمود التالي له ؟!

أمر آخر وهو الأهم أنك لم تستخدم هذا المتغير في عمود البحث ..لاحظ السطر التالي

If myArray(X, 1) Like targt & "*" Then

لاحظ استخدام الرقم 1 بدلاً من المتغير targtN ، وهذا سيجعل البحث محصوراً في العمود الأول فقط ..

تقبل تحياتي

حبيبي ابو والبراء انهي تعديل فيهم

انا عدلت الملف خمشتراشر مرة  وفعلا في احد التعديلات خليت البحث على عمود واحد

فيه اللي عايز بحث ناجح او راسب فقط وفي معايير بحث مختلفه

كلٍ حسب طلبه

تقبل تحياتي

[ابن بنها]

ماشاء الله تبارك الله

كود سريع جدا

[ياسر خليل أبو البراء]

ولا يهمك يا أبو العربي ..

كثرة التعديلات تشتت المتابعين في الحقيقة

ولكني أعمل دائماً على آخر تطور للأحداث وأقصد الملف المرفق المسمى ListBox

[ياسر العربى]

تسلم حبيبي ابو البراء انت صح الملف خطأ

تم تعديل المرفق والكود كما موضح

Private Sub TextBox1_Change()
    Dim myArray, lr, X, targt, targtN
    Dim SERCH As Worksheet, DATA As Worksheet
    '____________________________________________
    Set DATA = Worksheets("Sheet2")    'اسم شيت قاعدة البيانات
    Set SERCH = Worksheets("Sheet1")    'اسم الشيت الخاص بالبحث
    '____________________________________________
    lr = DATA.Cells(Rows.Count, 1).End(xlUp).Row    'اخر صف به بيانات
    ListBox1.Clear  'مسح نطاق البحث القديم
    targt = TextBox1.Text   'خلية البحث
    targtN = ComboBox1.ListIndex + 1    'دالة لايجاد رقم عمود البحث
    myArray = DATA.Range("A2:J" & lr + 1)    'نطاق البحث
    '____________________________________________
    ReDim y(1 To lr, 1 To 10)
    For X = 1 To lr
        If targt = "" Then Exit Sub
        If myArray(X, targtN) Like targt & "*" Then
            rw = rw + 1
            For yy = 1 To 10
                y(rw, yy) = myArray(X, yy)
            Next yy
        End If
    Next X
    If rw > 0 Then
        ListBox1.AddItem
        ListBox1.List = y()
    End If
End Sub

عرفت الرقم زاد ليه

تقبل تحياتي

[ياسر خليل أبو البراء]

جميل إنك غيرت فكرك في دالة عمود البحث

عايز تتنصل من الأفكار القديمة شوية ..شايفك معتمد على Lr آخر صف في أكتر من سطر .. أما آن الأوان لاستخدام كلمة UBOUND يليها قوس مفتوح ثم اسم المصفوفة المطلوب معرفة أقصى عدد للصفوف أو الأعمدة ثم فاصلة ثم الرقم 1 إذا كنت تريد الحصول على أقصى عدد للصفوف أو الرقم 2 إذا كنت تريد الحصول على أقصى رقم للأعمدة ..

هذا سيجعل الكود أكثر مرونة .. ويلا بالمرة كمل جميلك وخليه التعديل رقم 17 ..

 

وبردو فيه رقم واحد في السطر ده معرفشي لازمت ايه ..

myArray = DATA.Range("A2:J" & lr + 1)

تقبل تحياتي

[ياسر العربى]

اضافة 1 هنا بسبب اختلاف المصفوفات عن النطاقات من حيث انها تبدأ بصفر
جرب شيل ال1 وهديك out of range

طبعا طالما هنخش ع المصفوفات وشغلها ونبعد عن النطاقات دي وطبعا بعيد عن زود واحد نقص واحد الحل الامثل كما ذكرت

Private Sub TextBox1_Change()
    Dim myArray, lr, X, targt, targtN
    Dim DATA As Worksheet
    '____________________________________________
    Set DATA = Worksheets("Sheet2")   
    '____________________________________________
    lr = DATA.Cells(Rows.Count, 1).End(xlUp).Row    
    ListBox1.Clear  
    targt = TextBox1.Text  
    targtN = ComboBox1.ListIndex + 1    
    myArray = DATA.Range("A2:J" & lr)  
    '____________________________________________
    ReDim y(1 To UBound(myArray, 1), 1 To UBound(myArray, 2))
    For X = LBound(myArray) To UBound(myArray)
        If targt = "" Then Exit Sub
        If myArray(X, targtN) Like targt & "*" Then
            rw = rw + 1
            For yy = 1 To 10
                y(rw, yy) = myArray(X, yy)
            Next yy
        End If
    Next X
    If rw > 0 Then
        ListBox1.AddItem
        ListBox1.List = y()
    End If
End Sub

منتظر التعديل التالي ولا اقولك لا مش  هعدل طالما النتائج سليمة

[احمد عبدالحليم]

ما اجمل النقاش بين العمالقة :- الياسران

استاذى ياسر خليل ابو البراء & استاذى ياسر العربى

جزاكم الله خيرا على اعمالكم الرائعة

[إبراهيم ابوليله]

اخى ياسر

برنس والله

موضوع المصفوفات دى جامد جدا

وبصراحه محتاج شرح طويل

وجهود كبير

علشان نفهمه

ولكن ادحنا بنحاول

على العموم

كنت بسأل ازاى نخلى الاستخراج يبدأ من السطر 12

[ياسر خليل أبو البراء]

عوداً حميداً أخي وحبيبي إبراهيم ..

أين كنت يا رجل ؟ أما افتقدت إخوانك!!

شوف الرابط ده فيه شرح لكود أخونا العربي

http://yasserkhalilexcellover.blogspot.com.eg/2016/10/search-using-arrays.html

[abbermustfa]

جزاكم الله خيرا .. كود روعه

 

[عاطف عبد العليم محمد]

الأخ / ياسر العربي

السلام عليكم

هل المصفوفة لها حد اقصى من عدد الصفوف ؟ وماهو ؟

 

[ياسر خليل أبو البراء]

الحد الأقضى هو عدد صفوف ورقة العمل .. هذا والله أعلى وأعلم

[إبراهيم ابوليله]

في 10/19/2016 at 18:28, ياسر خليل أبو البراء said:

عوداً حميداً أخي وحبيبي إبراهيم ..

أين كنت يا رجل ؟ أما افتقدت إخوانك!!

شوف الرابط ده فيه شرح لكود أخونا العربي

http://yasserkhalilexcellover.blogspot.com.eg/2016/10/search-using-arrays.html

اخى اواستاذى الحبيب ياسر خليل

بارك الله فيك

واشكرك على الترحيب والسؤال

لكن بجد الحياه اصبعت من الاصعب الى الاصعب

واصبحنا مشغولين بشده بحثا عنى لقمة العيش

وهذا هو سبب البعد عن احبائنا واخواننا فى هذا المنتدى

للاسف مشاغل الحياه كما تعلم تفوق كل شئ

على العموم تقبل تحياتى

[عاطف عبد العليم محمد]

السلام عليكم

هل يمكن تدارك العيب الآتي

لو البحث عن القيود المتعلقة بالحساب رقم  1 فستكون نتيجة البحث كل القيود المتعلقة بالحساب 1 و 21 و31 و41 و..... وهلم جرا

وفقك الله الجميع لما يحب ويرضى

 

[ياسر خليل أبو البراء]

وعليكم السلام

 If Arr(I, 14) Like "*" & strSearch & "*" Then

استخدم السطر التالي بدلاً منه

 If Arr(I, 14) Like strSearch Then