طلب كود مع طريقة لإنشاء قائمة منسدلة الكتابة تكون في خلية وفي عدة صفوف مع وجود لخاصية البحث فيها

[faisal_kg]

السلام عليكم أساتذتنا الأفاضل..

منضم جديد للموقع.

حاولت البحث تكرارا عن كود vba لعمل قائمة منسدلة مع خاصية البحث تكون مشابهة للموجودة في Excel 365 (جهازي اكسل 2010) ...وجميع ماوجدته لا يفي بالمطلوب وما ابحث عنه هو:

*قائمة منسدلة مكررة في عدة صفوف والكتابة تكون في الخلية وليس في صندوق منفصل .

* تكون فيها خاصية البحث...

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

*يفضل أن لايشمل البحث جلب الخيارات المطابقة للاحرف الموجودة في وسط الكلمة او في جزئها الثاني ان وجد لو أمكن.

فمثلا في قائمة مكونة من عدة دول.. موجودة في العمود C  عند وضع المؤشر في خلية القائمة المنسدلة في العمود A ونقوم بكتابة الحرف a (لايهم capital/small) تظهر مباشرة في القائمة المنسدلة الدول فقط التي تبدأ بنفس الحرف مثل: Algeria, Albania , Austria, Australia,… ولا تظهر الدول التي في وسطها الحرف a مثل Mali أو الدول الموجود في بداية جزئها الثاني مثل South Africa ... وهكذا.

وشكرا

 

قائمة منسدلة مع البحث والاكمال التلقائي.xlsx

[محمد هشام.]

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

إدا كنت قد فهمت طلبك بشكل صحيح فربما هدا سيوفي بالغرض

Option Explicit
Dim WS As Worksheet
Dim OnRng As Variant

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Set WS = Sheets("Sheet1")

    If Not Intersect([A2:A11], Target) Is Nothing And Target.Count = 1 Then
        OnRng = WS.Range("C2:C" & WS.Cells(WS.Rows.Count, "C").End(xlUp).Row).value
        Me.ComboBox1.List = Application.Transpose(OnRng)
        Me.ComboBox1.Height = Target.Height + 3
        Me.ComboBox1.Width = Target.Width
        Me.ComboBox1.Top = Target.Top
        Me.ComboBox1.Left = Target.Left
        Me.ComboBox1.value = Target.value
        Me.ComboBox1.Visible = True
        Me.ComboBox1.Activate
    Else
        Me.ComboBox1.Visible = False
    End If
End Sub

Private Sub ComboBox1_Change()
    If Me.ComboBox1.value <> "" Then
        Dim d1 As Object
        Set d1 = CreateObject("Scripting.Dictionary")
        Dim tmp As String
        tmp = UCase(Me.ComboBox1.value) & "*"
        
        Dim i As Long
        For i = 1 To UBound(OnRng, 1)
            If UCase(OnRng(i, 1)) Like tmp Then d1(OnRng(i, 1)) = ""
        Next i
        
        Me.ComboBox1.List = d1.Keys
        Me.ComboBox1.DropDown
    End If
    ActiveCell.value = Me.ComboBox1.value
End Sub

Private Sub ComboBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    Me.ComboBox1.List = Application.Transpose(OnRng)
    Me.ComboBox1.Activate
    Me.ComboBox1.DropDown
End Sub

Private Sub ComboBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    If KeyCode = 13 Then
        ActiveCell.Offset(1).Select
    End If
End Sub

 

قائمة منسدلة مع البحث والاكمال التلقائي.xlsb

تم تعديل الأربعاء at 01:54 بواسطه محمد هشام.

[faisal_kg]

أشكرك.... رائع جدا وفتح الله عليك... أخيرا بعد البحث المتواصل.. وسأقوم بتجربة الكود على ملفي الخاص