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

[حاتم عيسى]

بسم الله الرحمن الرحيم

السادة الأفاضل : مشرفي ورواد المنتدى المحترمين

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

Private Sub TextBox28_Change()
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
ListBox1.Clear
Dim Arr_Sh, Itm
Dim k%, b%

Arr_Sh = Array("Data_1")     ''يمكن هنا اضافة اسماء الشيتات التي تريد البحث فيها
If TextBox28.Value = "" Then ListBox1.Clear: Exit Sub
Dim x As Worksheet
Dim c As Range
ListBox1.Clear
k = 0
For Each Itm In Arr_Sh
     Set x = Sheets(Itm)
     ss = x.Cells(Rows.Count, 9).End(xlUp).Row
     If ss < 9 Then GoTo Next_Item
    For Each c In x.Range("B9:B" & ss)
        b = InStr(c, TextBox28)
        If Trim(c) Like TextBox28 & "*" Then
        ListBox1.AddItem
        ListBox1.List(k, 0) = x.Cells(c.Row, 2)
        ListBox1.List(k, 1) = c.Worksheet.Name
        ListBox1.List(k, 2) = c.Row
        k = k + 1
        End If
TextBox28.SetFocus
    Next c
Next_Item:
Next Itm
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
'
End Sub

حيث عند اختيار البحث ببداية الاسم يتم البحث في الشيت المحدد ( Data_1 ) في عمود الاسم في الاسم الاول من الاسم

وعند اختيار البحث بأجزاء الاسم يتم البحث في أي جزء من الاسم في الشيت المحدد ( Data_1 ) في العمود رقم 2 والمحتوى على الاسم

مرفق صورة النموذج للتوضيح وكذلك ملف العمل المراد التعديل عليه .

وشكرا لحضراتكم جميعا مقدمًا

التعديل على كود البحث.xlsm

[أ / محمد صالح]

لا يوجد في الكود شيء يخص طريقة البحث

الكود للبحث بأول الخلية فقط

للوصول للمطلوب يمكنك تغيير هذا السطر

If Trim(c) Like TextBox28 & "*" Then

إلى

If Trim(c) Like IIf(Me.OptionButton2, "*", "") & TextBox28 & "*" Then

وإضافة هذين الحدثين عند الضغط على طريقة البحث

Private Sub OptionButton1_Click()
TextBox28_Change
End Sub

Private Sub OptionButton2_Click()
TextBox28_Change
End Sub

بالتوفيق

[حاتم عيسى]

الأستاذ الفاضل المحترم : أ / محمد صالح

تحية طيبة ... وبعد

بارك الله في حضرتك وسلمت يداك وجعل الله جميع أعمالك في موازين حسناتك ونفعك بعلمك

ولو تكرمت وتفضلت علينا :

ممكن أطمع في كرم أخلاق حضرتك وأن يكون الاختيار الافتراضي أن تكون أداة OptionButton1 هى المختارة والمحددة افتراضياً

[أ / محمد صالح]

شكرا للكلماتك الطيبة

في properties الخاص بها 

غير value إلى true 

[حاتم عيسى]

الأستاذ الفاضل المحترم : أ / محمد صالح

تحية طيبة ... وبعد

بارك الله في حضرتك وسلمت يداك وجعل الله جميع أعمالك في موازين حسناتك ونفعك بعلمك وأكثر من أمثال حضرتك ونفع الله بك الأمة الإسلامية جميعًا ....

أكثر من رائع

[أ / محمد صالح]

جميعا بإذن الله تعالى