بحث بأكثر من شرطين

[Goldkamel]

 

هل يمكن اضافة خانة استعلام ثالثة و زر البحث لان قاعدة البيانات كبيرة جدا و يستحسن عدم اظهار اي شيء الا بعد الضغط على زر البحث

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

بحث بشرطين.xlsm

[mn20]

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

الملف به ثلاث خانات للبحث (تمت اضافة الوحدة كعنصر للبحث .. لأنكم لم تحددوا ما العمود المطلوب البحث فيه) مع اجتهاد بسيط بوضع البيانات الأساسية في ورقة (Prime).

 

بحث بشرطين.xlsm

[Goldkamel]

شكرا اخي و بارك الله فيك 

سأجرب الملف المرفق

 

اود لو كان عنصر البحث حرا و ليس مقيدا بلائحة

Textbox احسن 

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

[محمد هشام.]

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

2) الملف غير منظم مما يشكل صعوبة لفهم المطلوب جيدا ربما كان من الافضل فقط تصميم يوزرفورم وطلب المساعدة بتكملت الاكواد احسن من التعديل على ملف قديم لا يناسب طلبك .

تم تعديل فبراير 20, 2023 بواسطه Mohamed Hicham

[Goldkamel]

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

 

البحث فى كل اوراق العمل.xlsb

تم تعديل فبراير 20, 2023 بواسطه Goldkamel
changement de fichier

[محمد هشام.]

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

[Goldkamel]

منذ ساعه, Mohamed Hicham said:

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

 

تماما نفس النطاق عندي

كيف يمكن اضافة هذا الكود ؟

Private Sub TxSh_Change()
If CmbClom = "" Then MsgBox "البحث من بداية الكلمة": Exit Sub
Serch TxSh, CmbClom.ListIndex + 1, CheckFind.Value
End Sub

[محمد هشام.]

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

[Goldkamel]

35 دقائق مضت, Mohamed Hicham said:

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

اعتذر أخي عن التأخر كنت احاول فهم برمجتك

اود شكرك مرة أخرى

نعم البحث في كل الشيتات

و لقد حددت المطلوب هكذا

 

انت وضعتى البحث في الاعمدة recherche                h        b        c
و النتيجة تظهر هكذا   resultat        a    b    c        d    e    f    g    h

انا اريد البحث عن الاعمدة   D  E    F 
لكن لم استطع ذلك
ملاحظة 
طريقتك في البرمجة رائعة كونها بسيطة للغاية 
 

بحث بشرطين kml2.xlsm

[Goldkamel]

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

تم تعديل فبراير 21, 2023 بواسطه Goldkamel

[محمد هشام.]

بما انك مصر على نفس الفكرة ونفس اليوزرفورم تفضل اخي يمكنك تغيير الاكواد بالشكل التالي

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

Dim f, rng, MH(), Ncol
'21/02/2022  اوفيسنا
Private Sub UserForm_Initialize()
Dim ST
Set f = Sheets("Follow up")
  Set rng = f.Range("A5:J" & f.[A65000].End(xlUp).Row)
  MH = rng.Value
  ST = f.[A4].CurrentRegion.Columns.Count
  Me.ListBox1.ColumnCount = ST
  Set plage = f.[A4].CurrentRegion
  Set plage = plage.Offset(1).Resize(plage.Rows.Count - 1)
  x = Me.ListBox1.Left + 8
  y = Me.ListBox1.Top - 12
  For i = 1 To ST
    Set Lab = Me.Frame1.Controls.Add("Forms.Label.1")
    Lab.Caption = f.Cells(4, i)
    Lab.Top = y
    Lab.Left = x
    x = x + f.Columns(i).Width * 1.02
    temp = temp & f.Columns(i).Width * 1.02 & ";"
  Next
  temp = Left(temp, Len(temp) - 1)
  Me.ListBox1.ColumnWidths = temp
  Me.Frame1.ScrollWidth = Me.ListBox1.Width + 10
  Me.Frame1.ScrollBars = 1
'  Me.ListBox1.List = plage.Value  '  يمكنك تفعيل هدا الخيار لاظهار البيانات على الليست بوكس
  Me.ComboChoixColFiltre.List = Application.Transpose(rng.Offset(-1).Resize(1))
  Me.ComboChoixColFiltre.ListIndex = 0
  Me.LabelColFiltre.Caption = "فلترة ب:" & Me.ComboChoixColFiltre
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub ComboChoixColFiltre_click()
  Me.LabelColFiltre.Caption = "فلترة ب:" & Me.ComboChoixColFiltre
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub CommandButton1_Click()
If Recherche.Value = Empty Then
MsgBox "المرجوا ادخال معيار البحث", vbInformation + vbMsgBoxRight + vbMagBoxRt1Reading, "تعليمات"
Exit Sub
End If
colRecherche = Me.ComboChoixColFiltre.ListIndex + 1
  clé = "*" & Me.Recherche & "*": N = 0
  Dim Tbl()
  For i = 1 To UBound(MH)
    If MH(i, colRecherche) Like clé Then
        N = N + 1: ReDim Preserve Tbl(1 To UBound(MH, 2), 1 To N)
        For k = 1 To UBound(MH, 2): Tbl(k, N) = MH(i, k): Next k
     End If
  Next i
  If N > 0 Then Me.ListBox1.Column = Tbl Else Me.ListBox1.Clear
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub Recherche_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
  If Not iGblInhibitTextBoxEvents Then
    Recherche.Value = Empty
  End If
End Sub

ملاحظة البحث يكون فقط على نفس الشيت

Test_User.xlsm

[Goldkamel]

اعتذر لأني لم أجرب بعد

ساحاول تجربة التغيير كما قلت 

و اتمنى ان يكون البحث و اختيار المعايير اثنين على الأقل 

شكرا مجددا

 

[mn20]

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

استاذي محمد Mohamed Hicham ما شاء الله تبارك الله كود جميل وفكر رائع ( لا زلت احلله واتعلم منه ما شاء الله).

أوافقكم الرأي بوجوب توضيح المطلوب وتحديدها وهو ما حاول Goldkamel  أن يعرضه من خلال ملفين الأول متعلق بالصيانة ، والآخر متعلق ببيانات مدرسية.

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

يمكن تحديد ثلاث عناصر للبحث، ويمكن اختيار اي عمود للبحث فيه، مع الحرية في تحديد البيانات التي ترغب في عرضها في القائمة كنتيجة لعملية البحث.

ملاحظات: مع اسفي على تشتتي بين الملفات المرفوعة ومحاولة تحديد المطلوب مع تقديم المقترح في ردي الأول بأهمية وجود ورقة (Prime) تتضمن القوائم التي من خلالها يتم توحيد الادخال والبحث والمعالجة لتجنب الأخطاء المطبعية عند الادخال أو البحث، وعند الرغبة في البحث في اكثر من ورقة فيجب مراعاة توحيد الأعمدة في جميع أوراق العمل.

 

بحث بشرطين kml2.xlsm البحث فى كل اوراق العمل.xlsb

تم تعديل فبراير 21, 2023 بواسطه mn20

[Goldkamel]

أخجلتموني

منكم نتعلم الكثير

ملاحظة بسيطة  حيث لا بمكن البحث بالاعداد العشرية "الفاصلة" 5,5 مثلا

 وفقكم الله لكل مافيه الخير

@Mohamed Hicham

@mn20

[Goldkamel]

With Application
.DecimalSeparator = "."
.ThousandsSeparator = " "
.UseSystemSeparators = False
End With

[Goldkamel]

في 21‏/2‏/2023 at 15:27, Goldkamel said:

أخجلتموني

منكم نتعلم الكثير

ملاحظة بسيطة  حيث لا بمكن البحث بالاعداد العشرية "الفاصلة" 5,5 مثلا

 وفقكم الله لكل مافيه الخير

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

 With Application
.DecimalSeparator = "."
.ThousandsSeparator = " "
.UseSystemSeparators = False
End With

@Mohamed Hicham

@mn20

 

[mn20]

اذا كان المطوب البحث بالفاصلة العشرية .. فتم التعديل

البحث فى كل اوراق العمل.xlsb بحث بشرطين kml2.xlsm

[Goldkamel]

بارك الله فيك أخي و استاذي

هل استعملت 

With application décimal separator

اضن انه يغير مميزات الخلايا ام اني خاطئ

[Goldkamel]

في 21‏/2‏/2023 at 15:27, Goldkamel said:

لم تنجح العملية للاسف و لكني احاول فهم الخل

حيث اسعى لجعله يتعامل مع شيتات بعد استيرادها الى هذا الملف

وفقكم الله لكل مافيه الخير

@Mohamed Hicham

@mn20