كيف يمكن اضافة نتائج بحث الى Listbox فى UserForm

[Amr Ashraf]

السلام عليكم ,, كل عام وحضراتكم بخير 

عندي استفسارين فى الاكسيل بما انه ليس من مناطق قوتى 😅 واتمنى سعة الصدر .

 الملف المرفق به 2 شيت (Data,يومية الانتاج) وبه يوزر فورم المطلوب منه البحث بجزء من الكلمة فى شيت Data فى نطاق محدد متغير بناء على اختيار RadioButton فإذا كان الهدف من البحث هو ايجاد اسم عامل فيتم البحث فى نطاق اسمه "EmpData" فى شيت Data  واذا كان الهدف ايجاد اسم مرحلة فيتم البحث فى النطاق "Process" , ثم اظهار نتيجة البحث فى Listbox فى اليوزر فورم السابق الاشارة اليه.

قمت بعمل الكود التالى :

Private Sub TextBox1_Change()
Dim searchData As Range
Dim cell As Range
Dim i As Long

'Determine which search data to use based on radio buttons

  Select Case True
        Case Process.Value = True
            Set searchData = ThisWorkbook.Worksheets("Data").Range("Data")
        Case Emp.Value = True
            Set searchData = ThisWorkbook.Worksheets("Data").Range("EmpData")
        Case Else
            'No radio button is selected
            Exit Sub
    End Select

'Clear the ListBox1
ListBox1.Clear

'Find matching values and add them to ListBox1
For Each cell In searchData
    If InStr(1, cell.Value, TextBox1.Value, vbTextCompare) > 0 Then
        ListBox1.AddItem cell.Value
    End If
Next cell

'Select the first item in the ListBox1
If ListBox1.ListCount > 0 Then
    ListBox1.Selected(0) = True
End If

End Sub

    

الكود يبحث بنجاح ولكن يظهر عمود واحد فقط فى نتيجة البحث على عكس المطلوب وهو اظهار عدد اعمدة متغيرة طبقاً للنطاق الذى يتم البحث فيه .

مثال للتوضيح :

فى الصورة المرفقة قمت بالبحث عن عامل يسمى حسن , النتيجة كانت كالتالى :

قام بعرض عمود واحد وبه الاسم المطلوب , ولكن المطلوب عرضه هو السطر كامل الذى يحتوى على حسن وبه 5 اعمدة , وبالتالى النتيجة المرجوة ينبغي ان تكون كالتالي :

المطلوب عرض النتيجة بهذا الشكل فى Listbox .

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

الاستفسار الثاني :

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

 

ملحوظة : يمكننى عمل الموضوع فى الاكسيس فى 3 دقائق ولكني ابحث منذ 3 ساعات لرغبتى فى عمله على الاكسيل .😅

اعذروني على الموضوع الطويل , جزاكم الله خير🥰

Search.xlsm

[حسونة حسين]

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

54 دقائق مضت, Amr Ashraf said:

ListBox1.AddItem cell.Value

هنا تمت اضافه الكلمه التي تم البحث عنها فقط

لابد من اضافه باقي الاعمده في الليست بوكس 

 

 

 

[Amr Ashraf]

40 دقائق مضت, حسونة حسين said:

هنا تمت اضافه الكلمه التي تم البحث عنها فقط

 

مشكور اخى الكريم على المشاركة , هل يمكنك ارفاق كود كمثال للمطلوب ؟

جزاكم الله خير

[حسونة حسين]

اخي @Amr Ashraf

جرب هذا التعديل

Private Sub TextBox1_Change()
    Dim searchData As Range, Sh As Worksheet
    Dim Cell As Range
    Dim i As Long, A As Long
    Set Sh = ThisWorkbook.Worksheets("Data")
    'Determine which search data to use based on radio buttons
    A = 0
    Select Case True
    Case Process.Value = True
        Set searchData = ThisWorkbook.Worksheets("Data").Range("Data")
        ListBox1.ColumnWidths = "60,60,60" 'ColumnWidths of the ListBox1
    Case Emp.Value = True
        Set searchData = ThisWorkbook.Worksheets("Data").Range("EmpData")
        ListBox1.ColumnWidths = "60,60,60,60,60" 'ColumnWidths of the ListBox1
    Case Else
        'No radio button is selected
        Exit Sub
    End Select

    ListBox1.Clear 'Clear the ListBox1
    ListBox1.ColumnCount = searchData.Columns.Count ' ColumnCount of the ListBox1
    
    If TextBox1.Value = "" Then Exit Sub
    'Find matching values and add them to ListBox1
    For Each Cell In searchData
        If InStr(1, Cell.Value, TextBox1.Value, vbTextCompare) > 0 Then
            ListBox1.AddItem
            For i = 0 To searchData.Columns.Count - 1
                ListBox1.List(A, i) = Sh.Cells(Cell.Row, Cell.Column + i - 1).Value
            Next i
            A = A + 1
        End If
    Next Cell

    'Select the first item in the ListBox1
    If ListBox1.ListCount > 0 Then
        ListBox1.Selected(0) = True
    End If

End Sub

 

هذا بالنسبه للإستفسار الاول

[Amr Ashraf]

10 دقائق مضت, حسونة حسين said:

جرب هذا التعديل

بارك الله فيك , هو المطلوب ولكن ينقصه رؤوس الاعمدة فقط .

[حسونة حسين]

رؤوس الاعمده ابسط حاجه

ممكن تعملها ب labels

فوق الليست بوكس

 

[Amr Ashraf]

جزاك الله خير أخى الكريم  @حسونة حسين..

فى انتظار أحد الأخوة يفيدنا فى الاستفسار الثانى

تم تعديل مارس 23, 2023 بواسطه Amr Ashraf

[حسونة حسين]

كيف اضبط Label مع رؤوس الاعمدة فى الليس بوكس

 

[Amr Ashraf]

السلام عليكم ,, تم حل الاستفسار الثانى عن طريق الكود 

Private Sub Copy_Click()
    Dim lngSelected As Long, lngRows As Long, lngColumn As Long
    Dim myArray(1 To 9)
    
    For lngSelected = 0 To Me.ListBox1.ListCount - 1
        If Me.ListBox1.Selected(lngSelected) Then
            lngRows = lngRows + 1
            For lngColumn = 1 To 2
                myArray(lngColumn) = Me.ListBox1.List(lngSelected, lngColumn - 1)
            Next lngColumn
            Worksheets("يومية الانتاج").Range("C" & Rows.Count).End(xlUp).Offset(1).Resize(, 2) = myArray
        End If
    Next lngSelected
    
    MsgBox "Done"
    Me.Process.Value = True
    Me.TextBox1.SetFocus
    Me.TextBox1.Value = ""
   
End Sub

شكرا للأخ @حسونة حسين

[حسونة حسين]

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

الشكر لله اخى @Amr Ashraf

الحمد لله الذي بنعمته تتم الصالحات