قائمه منسدله تبحث بالاسم

[elmansyeswa]

سجل.xlsx

[محمد هشام.]

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

هل هناك مانع لاستخدام الأكواد؟

[elmansyeswa]

لا مانع بس محتاج الشيت يكون خفيف

لانة هيشتغل على جهاز مكتبى ضعيف الامكانيات

مع العلم ان الشيت هيبقى عدد الشيتات الداخلي فية كتير اكتر من 18

فهل هذا ممكن

 

[محمد هشام.]

ضع الكود التالي في حدث ورقة  DATA لجلب اسماء العملاء 

Private Sub Worksheet_Change(ByVal Target As Range)

 Set F = Sheets("DATA"): Set n = F.[G2]
 
 With Application
    .ScreenUpdating = False
  .EnableEvents = False
   
If Target.Column = 1 Then
F.Range("G2:G" & F.UsedRange.Rows.Count).ClearContents
  Set d = CreateObject("Scripting.Dictionary")
  a = Range(F.[A2], F.[A65000].End(xlUp)).Value
  For Each c In a
     d(c) = ""
  Next c
n.Resize(d.Count, 1) = Application.Transpose(d.keys)
   n.Resize(d.Count, 1).Sort Key1:=n, Order1:=xlAscending
      Set d = Nothing
  End If
  
  .EnableEvents = True
    .ScreenUpdating = True
  End With
End Sub

مع تسمية النطاق وليكن مثلا list

واخيرا قم بنسخ هدا في حدث ورقة 7

Option Compare Text
Dim F(), OneRng, lr&
Public Property Get Sh2() As Worksheet: Set Sh2 = Worksheets("DATA")
End Property
Private Sub ComboBox1_Change()
Dim Cnt()
Set OneRng = ActiveCell: Cnt = Application.Transpose([List])
Me.ComboBox1.List = Cnt
If Me.ComboBox1.ListIndex = -1 And _
                    IsError(Application.Match(Me.ComboBox1, Cnt, 0)) Then
   Me.ComboBox1.List = Filter(Cnt, Me.ComboBox1.Text, True, vbTextCompare)
   Me.ComboBox1.DropDown
End If
  OneRng.Value = Me.ComboBox1
End Sub
'*************************
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim sh1 As Worksheet: Set sh1 = Worksheets("7")
lr = 150 'sh1.Range("a" & sh1.Rows.Count).End(xlUp).Row
 Set tmp = Range("C4:C" & lr)
   If Not Intersect(tmp, Target) Is Nothing And Target.Count = 1 Then
      If Cnt <> "" Then If IsError(Application.Match(Range(Cnt), F, 0)) Then Range(Cnt) = ""
F = Application.Transpose(Sh2.Range("list"))
 Me.ComboBox1.Height = Target.Height + 4
 Me.ComboBox1.Width = Target.Width
  Me.ComboBox1.BackColor = RGB(204, 253, 253)
    Me.ComboBox1.Top = Target.Top: Me.ComboBox1.Left = Target.Left: Me.ComboBox1 = Target
    Me.ComboBox1.Visible = True
    Me.ComboBox1.Activate
    Cnt = Target.Address
  Else
    Me.ComboBox1.Visible = False
  End If
End Sub
'*************************
Private Sub ComboBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
  Set OneRng = ActiveCell
  If KeyCode = 13 Then
    If IsError(Application.Match(OneRng, F, 0)) Then OneRng = ""
    OneRng.Offset(1).Select
  End If
End Sub
'*************************
Private Sub ComboBox1_DropButtonClick()
lr = Sh2.Cells(Rows.Count, 7).End(xlUp).Row
ComboBox1.List = Sh2.Range("G2:G" & lr).Value
End Sub
'*************************
Private Sub ComboBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
  If Not iGblInhibitTextBoxEvents Then
  ComboBox1.Value = ""
  End If
End Sub

البحث باي جزء من الاسم 

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

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim sh1 As Worksheet: Set sh1 = Worksheets("7") <======

 

 

قائمة بحث بجزء من الاسم.xlsb

تم تعديل يوليو 1 بواسطه محمد هشام.

[elmansyeswa]

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

[elmansyeswa]

بارك الله فيك اخى محمد هشام

لكن طلعلي الخطاء هذا عند تحديد نطاق للطباعة او النسخ

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

فهل بالامكان عملها بالاكواد

سجل.xlsb