فورم بحث بأكثر من ثلاث خيارات

[أنس دروبي]

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

اخواني الكرام بعد مدة طويلة من الغياب عنكم وعن ابداعاتكم وافكاركم المتميزة 

وذلك نظراً لمرضي الذي دام اكثر من شهرين متواصلين ولله الحمد على الصحة والعافية من المرض 

أتيت لكم بطلب صغير وبسيط ومتواضع بالنسبة لعلمكم المعطاء .

طلبي هو

يوجد في الملف المرفق فورم بحث متقدم بشكل متميز لأحد من أساتذتنا في هذا الصرح العملاق 

الفورم يقوم بأعطاء نتيجة البحث بناء على الاختيار من قائمة البحث وادخال التواريخ 

قمت بإضافة خيار  اخر للبحث وهو قائمة "النوع"بحيث يكون البحث

أولا بناء على اختيار المطلوب من قائمة (النوع)

ثانيا وبعدها الاختيار من القائمة الاخرى

ثالثاً ومن ثم التاريخ

أريد التعديل على نفس الكود الموجود نظراً لأداءه المتميز والأكثر من رائع في السرعة 

وجدت طرق قديمة ولكن لم تنفع نظراً لكثرة البيانات الكبيرة التي عندي 

أرجو أن يكون الشرح واضح 

بارك الله فيكم 

ملف بحث بفورم ممتاز.rar

[الصـقر]

اخى الحبيب انس 

حمد لله على سلامتك شفاك الله وعافك

اسال الله تعالى ان يشفيك شفاء لا يغادر سقما

اود ان الفت انتباه حضرتك الى الرابط التالى

وبخصوص طلبك تم تعديل الكود ليناسب طلبك

شاهد المرفق هل هو ما تريد

تقبل منى وافر الاحترام والتقدير

اخوك الصقر

ملف بحث بفورم ممتاز.zip

[أنس دروبي]

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

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

والحل الاكثر من رائع لم كنت اتوقع السهولة في الحل تكتفي في إضافة هذا الامر البرمجي البسيط

If ComboBox1.MatchFound = False Then GoTo 1
If ComboBox1.Value = .Cells(R, 2) Then

بارك الله فيكم وجزاكم كل خير على الخدمات التي تقدموها لطلاب العلم في هذا المجال 

وبالنسبة للترقية بارك الله فيكم على نشر الرسالة 

صراحة لم انتبه للموضوع الذي نشر حول ذلك الامر

أن شاء الله نكون عند حسن أدارة الموقع ونكون في خدمة طلاب العلم والمعرفة

الموضوع اصبح الأن مجاب بشكل كامل بارك الله فيكم

 

[أنس دروبي]

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

اخواني الكرام واساتذتي أتيت لكم اليوم "بفورم بحث قديم ومتميز لأستاذنا الكبير حمادة عمر"

طلبي هو نفس الطلب الاول ولكن على هذا الكود لغاية التنويع وعرض الافكار الجديدة والمبتكرة

قمت بوضع "تكست بوكس" جديد مربوط بقائمة "النوع"

ومن ثم البحث في "التكست بوكس الاول" بناء على القيمة الموجودة في "تكست بوكس النوع"

المطلوب هو مثل الطلب الاول ولكن على كود برمجي أخر

بارك الله فيكم وجزاكم الله كل خير

نتمى عرض الافكار والأراء حول الموضوع

 

طريقة تصميم فورم بحث عن طريق لست بوكس.rar

[أبو حنــــين]

السلام عليكم

اخي هل تريد البحث بمعيارين اي بناءا على مربع النص الاول و الثاني ؟

 

[أنس دروبي]

نعم هذا المطلوب 

المربع الاول مربوط بجدول النوع في الورقة (عامود b)

والمربع الثاني مربوط بجدول الترقيم (عامود A)

ولكن التعديل يكون على الكود نفسه نظراً لبساطته واداءه السريع

 

تم تعديل أبريل 20, 2016 بواسطه أنس دروبي
تعديل

[أنس دروبي]

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

أخواني وعلمائننا الافاضل هل من جديد حول المطلوب

 

[أبو حنــــين]

السلام عليكم

سأرفع الملف في موضوع مستقل ليستفيد الجميع و هذا تلبية لرغبتك

[أنس دروبي]

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

بارك الله فيك وجزاك الله كل خير اخي وحبيبي علئ هذا الفورم المتميز والسريع في الاداء والقوة في التنفيذ 

اخي الكريم ملفك يصلح لعمل كامل 

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

بارك الله فيك مرة اخرئ ولكن ملفك يصلح معي في اشياء اخرئ 

الذي اريده هو التعديل علئ نفس الكود في المشاركة نظرا لربط الكود في البرمجة باشياء اخرئ وهي تكست بوكسات وليبيل وايضا ليست بوكس 

اشكرك مرة اخرئ علئ تعبك وتمضية الوقت الكثير في انشاء البرنامج 

[أبو حنــــين]

Private Sub TextBox1_Change()
On Error Resume Next
Label1.Visible = True
Label2.Visible = True
Label3.Visible = True
Label4.Visible = True
Label5.Visible = True
Label6.Visible = True
ListBox1.Visible = True
'=======================================
Dim ws As Worksheet
Dim V As Integer
Dim LastRow As Integer
Dim M As String
Dim Q, F
ListBox1.Clear
If TextBox1.Text = "" Then GoTo 1
M = TextBox1.Text
Set ws = Sheets("Sheet1")
With ws
     LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
Set Q = .Range("A2:A" & LastRow).Find(M)
If Not Q Is Nothing Then
F = Q.Address
Do
If Application.WorksheetFunction.Search(M, Q, 0) = 1 Then
If Q.Offset(, 1) = TextBox8.Text Then
ListBox1.AddItem Q.Value
ListBox1.List(V, 1) = Q.Offset(0, 1).Value
ListBox1.List(V, 2) = Q.Offset(0, 2).Value
ListBox1.List(V, 3) = Q.Offset(0, 3).Value
ListBox1.List(V, 4) = Q.Offset(0, 4).Value
 V = V + 1
 End If: End If
 Set Q = .Range("A2:A" & LastRow).FindNext(Q)
 Loop While Not Q Is Nothing And Q.Address <> F
 End If
 End With
1 End Sub

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

لم اقم باي تغيير سوى إشرك مربع النص رقم 8 في البحث

 

 

 

[أنس دروبي]

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

وجزاكم الله كل خير على الملف الذي قدمته 

صراحة فيه كودات متميزة وخاصة 

الكود المرتبط ب"combobox" فيه ميزة "عدم التكرار" كانت سريعة جداً في الاداء

قمت بتجربتها على ملف كبير جداً فيه لايقل عن "200 الف خلية متكررة" وكانت سرعته خيالية نظراً لبرنامج أكسل

بارك الله فيك مرة أخرى

وأتشرف أن تكون من أول المجابين على هذا الموضوع 

 

[أبو حنــــين]

مرحبا

لم انتبه للموضوع و ساحاول فيه ان شاء الله

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