اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

الردود الموصى بها

قام بنشر

السلام عليكم ورحمة الله وبركاته / هل هنالك امكانية من جعل خيارين للبحث ببداية الاسم او باجزاء من الاسم كما في الصورة المرفقة.

كود البحث ببداية الاسم 

كود البحث في بداية الاسم
Dim X As Worksheet
Dim c As Range
ListBox1.Clear
k = 0
    For i = 1 To 55
            Controls("TextBox" & i).Text = ""
    Next i
    If TextBox100 = "" Then Exit Sub
      
  For Each X In ThisWorkbook.Worksheets
SS = X.Cells(Rows.Count, 7).End(xlUp).Row
For Each c In X.Range("G3:G" & SS)
b = InStr(c, TextBox100)
If Trim(c) Like TextBox100 & "*" Then
ListBox1.AddItem
ListBox1.List(k, 0) = X.Cells(c.Row, 7)
ListBox1.List(k, 1) = c.Worksheet.Name
ListBox1.List(k, 2) = c.Row
ListBox1.List(k, 3) = X.Name
k = k + 1
End If
Next c
Next X
End Sub
------------------------------------------------------------------------------------------------------------------------------
كود البحث في جزء من الاسم
Dim X As Worksheet
Dim c As Range
ListBox1.Clear
k = 0
    For i = 1 To 55
            Controls("TextBox" & i).Text = ""
    Next i
    If TextBox100 = "" Then Exit Sub
      
For Each X In ThisWorkbook.Worksheets
SS = X.Cells(Rows.Count, 7).End(xlUp).Row
For Each c In X.Range("G3:G" & SS)
b = InStr(c, TextBox100)
If Trim(c) Like "*" & TextBox100 & "*" Then
ListBox1.AddItem
ListBox1.List(k, 0) = X.Cells(c.Row, 7)
ListBox1.List(k, 1) = c.Worksheet.Name
ListBox1.List(k, 2) = c.Row
ListBox1.List(k, 3) = X.Name
k = k + 1
End If
Next c
Next X
End Sub
-----------------------------------------------------------------
حيث ان الفارق بينهما هو 
If Trim(c) Like TextBox100 & "*" Then
If Trim(c) Like "*" & TextBox100 & "*" Then

saerch.JPG

البحث في بداية الاسم.xlsm

  • أفضل إجابة
قام بنشر

الكود المطلوب


Private Sub TextBox27_Change()
Dim bol As Boolean
If TextBox27.Value <> "" Then
ListBox1.Visible = True
Else
ListBox1.Visible = False
End If

Dim x As Worksheet
Dim c As Range
ListBox1.Clear
k = 0
    For i = 1 To 26
            Controls("TextBox" & i).Text = ""
    Next i

    If TextBox27 = "" Then Exit Sub
    bol = Me.OptionButton1 = True
  If bol Then
      For Each x In ThisWorkbook.Worksheets
          SS = x.Cells(Rows.Count, 2).End(xlUp).Row
          For Each c In x.Range("B2:B" & SS)
                If Trim(c) Like TextBox27 & "*" 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
                  ListBox1.List(k, 3) = x.Name
                  k = k + 1
              End If
          Next c
      Next x
Else
      For Each x In ThisWorkbook.Worksheets
      SS = x.Cells(Rows.Count, 2).End(xlUp).Row
        For Each c In x.Range("B2:B" & SS)
          If Trim(c) Like "*" & TextBox27 & "*" 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
            ListBox1.List(k, 3) = x.Name
            k = k + 1
          End If
        Next c
      Next x
End If
End Sub

الملف مرفق

Allaq_User.xlsm

  • Like 2
قام بنشر

بارك الله فيك اخي/ الكود ممتاز جداُ . ولكن لو تكرمت ببعض التعديل بحيث يكون الخيار الأول افتراضياً 

قام بنشر

عندما افتح اليوزرفورم يكون الخيار الأول هو المختار كما في الصورة

9999.JPG

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information