اذهب الي المحتوي
أوفيسنا

فورم بحث متعدد جاهز فى الليست بوكس وترحيله لورقة اخرى_2


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

تم رفع هذا الكود فى مشاركة منفصله


حتى لا ننسى هذه المشاركة    البحث فى لست بوكس وترحيله لورقة معينة

 

تم ارفاق المشاركه من الفاضل _ أ /  عمرو.محمد

 

 

11 Amr.rar

 

مع شرح الكود

Private Sub TextBox1_Change()


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

'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' السطر القادم لتفادى اى خطأ فى الكود ومنع اظهار رسالة ال debug للمستخدم
On Error Resume Next

' بقوله  افرغ محتويات الليست بوكس  علشان لما تفتح الليست المرة القادمة متلاقيش البيانات المبحوث عنها المرة اللى فاتت موجودة
ListBox1.Clear

' متغيرات لاسم الصفحة والصفوف
Dim ws As Worksheet
Set ws = Sheets("data")
Dim i As Long
Dim v As Integer


'بقوله هنا  لو التكست بوكس اللى ببحث فيه مش فاضى نفذ اللى جاى
If Me.TextBox1.Text <> "" Then


'================================================


'هنا بقوله لو اتكتب فى التكست بوكس من غير ما تعلم على نوع البحث من التلات خيارات يطلعلك رسالة تنبيه انك لابد ان تختار اولا
'ويوقف تنفيذ باقى الكود

If Me.esm.Value = False And Me.ra2eesy.Value = False And far3y.Value = False Then
MsgBox "رجاء اختر نوع البحث اولا"
Me.TextBox1 = ""
Exit Sub
End If
'==============================================
'هنا بقى متغير اسمه lr   وده بيحددلى اخر صف فيه بيانات  فى العمود
lr = ws.Range("b" & Rows.Count).End(xlUp).Row


' بقوله من الصف الخامس لغاية اخر صف فيه بيانات     نفذ اللى جاى
' وديه اسمها حلقة تكرارية
For i = 5 To lr


' هنا متغيرات لتحديد الصفوف المبحوث بها  سواء بالاسم او الفرعى او الرئيسي
comp = ws.Cells(i, "b") 'اسم
comp2 = ws.Cells(i, "c") 'فرعى
comp3 = ws.Cells(i, "d") 'رئيسي


If ws.Cells(i, 1) <> "" Then

'============================================================
'لو البحث بالاسم هو اللى متحدد كومب هتبقي زى ماهى وهيبقى عمود البحث هو b
If Me.esm.Value = True Then
comp = comp
End If
'هنا لو الفرعى هو المتحدد كومب هتساوى كومب 2 اللى هو عمود البحث بالفرعى
If Me.far3y.Value = True Then
comp = comp2
End If
 'كذلك الامر هنا
If Me.ra2eesy.Value = True Then
comp = comp3
End If

 
 '============================================================


' اللى فات  هنستخدمه هنا فى داله البحث باى حرف فى الكلمة  من غير شرح كتير علشان يطول الشرح
' اللى يشغلك فيها  كومب اللى احنا معرفينه فوق وهو نطاق البحث
'واللى انت هتبحث فيه وهو التكست بوكس
'وهيقارن اللى كتبته فى التكست بوكس  بالبيانات اللى فى نطاق البحث

If InStr(1, comp, Me.TextBox1.Text, vbTextCompare) Then


' هنا بقوله لما تلاقى بيانات البحث ضيفها فى الليست بوكس
ListBox1.AddItem

'v ده متغير زى i  وده للصفوف
'الليست بتبتدى من الشمال لليمين  وهما اربع صفوف  (v,0) معناها الصف v اللى هيتكرر لو فى اكتر من نتيجة للبحث
'و zero  معناها العمود الاول فى الليست من الشمال وهكذا


' وهنا بقوله  ضيف نتائج البحث فى العمود 1 والصف i فى العمود التالت والصف v فى الليست بزكس وهكذا

Me.ListBox1.List(v, 3) = ws.Cells(i, 1).Value 'مسلسل
Me.ListBox1.List(v, 2) = ws.Cells(i, 2).Value 'اسم
Me.ListBox1.List(v, 1) = ws.Cells(i, 3).Value 'حساب فرعى
Me.ListBox1.List(v, 0) = ws.Cells(i, 4).Value 'رئيسي


'وديه علشان لو اكتر من نتيجة للبحث تتكرر ولو مكتبتهاش هيجيبلك نتيجة واحدة فقط
v = v + 1
' اقفل معادلات if
End If
End If

' اقفل الحلقة التكرارية for i = 5 to lr
Next i

'ولو الليست بوس فاضية مفيهاش صفوف او عدد صفوفها 0 امسحها علشان نتايج البحث السابقة متفضلش موجودة

If Me.ListBox1.ListCount = 0 Then
Me.ListBox1.Clear
End If

'كل اللى فات هيحصل لو التكست بوكش مش فاضى طيب لو فاضي امسح الليست بوكس
Else
Me.ListBox1.Clear
'اقفل قاعدة if
End If


End Sub

 

 

 و لا تنسونا من صالح الدعاء

  • Like 2
رابط هذا التعليق
شارك

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.

×
×
  • اضف...

Important Information