كود للبحث في الاكسل

[al7aer2]

اخي انا وضعت الصور وحملت صورتين وبينت فيهما الاعمدة حتى يسهل الامر.
لكن فوجئت بطريقة غير مهذبة وهجومية، بانه ينبغي أن توضح المقصود وما لم تفعل فلن يساعدك احد!!!
فقلت: الطلب واضح للمتخصص ولا حاجة لتوضيح أكثر. كل ما اريده هو انني عملت كودا صغيرا للموظفين فيه بياناتهم الشخصية لنحتفظ بالمعلومات وقت الطلب. وهذا الكود فيه مجموعة من الخلايا مقسمه حسب المعلومة ويضم تقريباً 20 خلية.
كل مااردته هو مساعدتي في كود للبحث عن الاسم بحيث بمجرد وضع الحرف الاول تأتي مجموعة من الاسماء التي تبدأ بهذا الحرف، وحينما انقر على الاسم المطوب تحضر معه كل بياناته الشخصية.
والبحث الذي عندي فقط يحضر الاسم المطابق كاملا.
وهذه الصور

بيانات للمنتدى.xlsm

[سليم حاصبيا]

تم اضافة 2 كود باسلوب مبسط

الكود الاول للاصافة (تكتب ما تريد اضافته في الخلية D5 مع جميع البيانات ثم ثضغظ الزر "اضافة") تكرار الاسم غير مسموح

والثاني للبحث (تكتب ما تريد البحث في الخلية F3  / اللون الأصفر/ ثم تضغط الزر "البحث عن الاسماء")
اذا كان الاسم غير موجود تخرج لك رسالة بهذا الأمر

Option Explicit
Private Sub Cmd_Add_Click()
Rem ------------------ Code for ADD ---------------
  Dim Last_2 As Integer
  Dim cont%, n%, m%, Ro%
  Dim ARR
  Dim First As Worksheet
  Dim Scd As Worksheet

Set First = Sheets("Sheet1"): Set Scd = Sheets("Sheet2")
n = Application.CountA(First.Range("Data_Rg"))
m = First.Range("Data_Rg").Cells.Count
If n <> m Then
  MsgBox "برجاء إدخال البيانات كاملة", vbCritical, "تنبيه"
Exit Sub
End If

ARR = Split(First.Range("Data_Rg").Address(0, 0), ",")
 Last_2 = Scd.Range("B:B").Find("").Row
 cont = Application.CountIf(Scd.Range("B3:B" & Last_2), First.Range("D5").Value)
If cont Then
 MsgBox "هذا الاسم موجود", vbCritical, "تنبيه"
 Exit Sub
End If
For Ro = LBound(ARR) To UBound(ARR)
 Scd.Cells(Last_2, 2).Offset(, Ro) = _
 First.Range(ARR(Ro))
Next
First.Range("Data_Rg").ClearContents
End Sub
Rem ------------------ end Of ADD ---------------
'++++++++++++++++++++++++++++++
Rem ------------------ code for saerch ___________
Private Sub Cmd_Saerch_Click()
 Dim Last_2 As Integer
  Dim cont%, m%, Ro%
  Dim ARR
  Dim First As Worksheet
  Dim Scd As Worksheet
On Error Resume Next
If Sheet1.Range("F3").Value = "" Then
MsgBox "برجاء إدخال اسم للبحث عن بياناته", vbCritical, "خطأ"
Exit Sub
End If
Set First = Sheets("Sheet1"): Set Scd = Sheets("Sheet2")
Last_2 = Scd.Cells(Rows.Count, 2).End(3).Row
 cont = Application.CountIf(Scd.Range("B3:B" & Last_2), _
       First.Range("F3").Value)
  If cont = 0 Then
   MsgBox "هذا الاسم غير موجود", vbCritical, "تنبيه"
  Exit Sub
 End If
ARR = Split(First.Range("Data_Rg").Address(0, 0), ",")
 m = Scd.Range("B1:B" & Last_2).Find(First.Range("F3").Value, lookat:=1).Row
 For Ro = LBound(ARR) To UBound(ARR)
   First.Range(ARR(Ro)) = _
  Scd.Cells(m, 2).Offset(, Ro)
 Next
 End Sub
Rem ------------------ End of saerch ___________

الملف مرفق

al7aer2.xlsm

[سليم حاصبيا]

اذا كان الملف الذي رفعته يعمل انقل بياناتك اليه (فقط محتوبات الصفحة الثانية)

كما اذكرك بأنه كان بوجد في ملفك خلايا مدمجة تعيق عمل الكود قمت انا بازالتها

أو بجب عليك تسمية النطاق (D9  D7  D5 )الخ..... باسم "Data_Rg" مع ازالة الخلايا المدمجة اولاً

كما في الصورة المرفقة

 

[أحمد يوسف]

تفضل اخى الكريم كود الأستاذ سليم ممتاز ويعمل بكفاءة عالية عندما تقوم بالبحث عن اى اسم وتجرى عليه التعديل يستجيب لك الكود بكل ما تقوم به وشوف الصور بنفسك

 

[al7aer_2]

الاخ الكريم سليم
ما عرفت اعالج المشكلة
 

Private Sub CommandButton2_Click()
Dim Last_2 As Integer
  Dim cont%, n%, m%, Ro%
  Dim ARR
  Dim First As Worksheet
  Dim Scd As Worksheet

Set First = Sheets("Sheet1"): Set Scd = Sheets("Sheet2")
n = Application.CountA(First.Range("D5"))
m = First.Range("D5").Cells.Count
If n <> m Then
  MsgBox "ÈÑÌÇÁ ÅÏÎÇá ÇáÈíÇäÇÊ ßÇãáÉ", vbCritical, "ÊäÈíå"
Exit Sub
End If

ARR = Split(First.Range("D5").Address(0, 0), ",")
 Last_2 = Scd.Range("B:B").Find("").Row
 cont = Application.CountIf(Scd.Range("B3:B" & Last_2), First.Range("D5").Value)
If cont Then
 MsgBox "åÐÇ ÇáÇÓã ãæÌæÏ", vbCritical, "ÊäÈíå"
 Exit Sub
End If
For Ro = LBound(ARR) To UBound(ARR)
 Scd.Cells(Last_2, 2).Offset(, Ro) = _
 First.Range(ARR(Ro))
Next
First.Range("D5").ClearContents
End Sub

استبدلت كل data reg ب العمود والسطر الاول من الشيت الاول وهو D5

ولكن لم يعمل البحث

اخي انا اريد البحث يعمل بمجرد وضع الاسم الاول او الحرف الاول. بحيث تخرج لي جميع الاسماء التي تبدا بالحرف م مثلا اذا كتبت م.

[سليم حاصبيا]

اسماء الازرار تغيرت عندي في الكود

مثلاُ زر الأضافة اصبح اسمه "Cmd_Add" لذلك يجب كتاية الاسماء الصحيحة للازرار في الكود

بالنسبة للرسالة Compile Error  امسح السطر حيث تشير لك به رسالة الخطأ

و اخيراً لما كل هذه المشاكل غليك فقط نسخ البيانات من صفحتك(Sheet2)
الى الصغحة التي غندي(Sheet2) و قم بأعمالك على الملف الذي رفعته لك

و هذا ملف (مرفق) اخر بنفس الشكل لكن فيه اضافات من حيث التعديل

 

al7aer2_New.xlsm

[سليم حاصبيا]

 انا اريد البحث يعمل بمجرد وضع الاسم الاول او الحرف الاول. بحيث تخرج لي جميع الاسماء التي تبدا بالحرف م مثلا  

هذا من المستحيل العمل هكذا 

لنفرص ان عندك 5 أسماء تبدأ بالحرف ب مثلاً  (بل يا سيدي اسمين)

كيف تريد ان تضع هذه الاسماء في خلية واحدة  (D5)  وهي التي لا تتسع الا الى اسم واحد

و بيانات هذا الاسماء (العامود الثاني ) قي حلية واجدة (D7) الخ.....

[سليم حاصبيا]

ما تقول كدا من الصبح

al7aer2_iist.xlsm

[al7aer_2]

أفهمك يا اخ سليم، لكن لماذا تتقيد بالخليه؟ يمكن مثلا جعلها خلية منسدلة
او اي طريقة اخرى تحقق الهدف.
مع كل المحبة لك والمودة وشكرا لك على الجواب والمساعدة.

أو استخدام الكوموبوكس

[سليم حاصبيا]

حرب هذا الملف صفحة Combo_Sheet

الصفحة Target ما زالت موجودة لكنها مخفية

تم حماية المعادلات لعدم العبث بها عن طريق الخطأ

اذا احببت ان تقوم بتعديل شيء ما  اذهب الى الصفحة الرئيسية تجد هناك الاسم الذي اخترته من الشيت Combo_Sheet باللون الاخصر (كي لا تقوم بالتفتيش عنه بين كل الاسماء)

al7aer2_iist_Combo.xlsm

[al7aer_2]

أشكرك ايها الغاليعلى تواصلك برغم الاستمرار في الاشكالات.
ادعو الله تعالى أن يجنبك كل مكروه ويحفظك ويرعاك .
هنا مشكلة ظهرت في بداية فتح الملف.

[سليم حاصبيا]

لا اعرف ما المشكلة عندك انا عندي يعمل بشكل ممتاز

جرب ان تغير اسم الملف الى اي اسم تريد (باللغة الأجنبية)

ثم ليس هذا الملف الذي رفعته لك الصورة توضح (لا وجود لكلمة Enter)

[al7aer_2]

احسنت مبدع.
بقي أنه لا أستطيع التعديل ولا استطيع الاضافة على الشيت.
أريد أن انقل الكود مباشرة على القديم الذي عندي.
ودمت مبدعا كريما.

[سليم حاصبيا]

بقي أنه لا أستطيع التعديل ولا استطيع الاضافة على الشيت.

قلت لك التعديل والاضافة تتم قي البشيت الاساسي

بالنسبة للتعديل

1-أطلب الاسم الذي تريد التعديل عليه من ComboBox (بعد اختيار الحرف أو الحروف الاولى منه بواسطة الــ TexBox)
2- اذهب الى الشيت الاساسي تراه باللون الاخضر

3- فم بما تريد من تعدبلات

4- هذا كل شيء

بالنسبة للاضافة

أضف ما تريد من اسماء في الشيت الاساسي (حتى 500 اسم) والماكرو يعمل طبيعي عتد كنابة أول حرف أو حروف

[al7aer_2]

اخي بعد الشكر والتقدير لك
أنا لست خبيرا بهذه الامور، بل مبتدئ جداً
و

اخي الكريم : لم اقصد التعديلات على الاسماء والبيانات
، بل أقصد أنني اريد أن اضيف خلايا اخرى في الشيت الاساسي واريد أن اضيف ازرارا اخرى واريد أن اضيف اصنافا لبيانات اخرى. مثلا: عمل الزوج او الزوجة، اسم الطفل الاول ، ولادته وهكذا واريد أن اضيف ازرارا كازرار تعديل البيانات او ازرار الخروج او او ازرار لوظيفة اخرى اراها ضرورية.
هذا اولا: وثانيا:
لماذا لا يمكن الكتابة عن الاسم المطلوب البحث عنه، في نفس الخلية المنسدلة، لماذا هناك خليتان، خلية فوق وخليه ثانية تظهر فيها الاسماء؟ ولماذا يمتنع الكتابة في نفس الخلية المنسدلة الثانية؟
ألا يمكن ان تكون خلية واحدة منسدلة عندما اكتب فيها الاسم تظهر النتائج فيها؟

 

[سليم حاصبيا]

اصبحت الطلبات اكثر مما توقعت و في كل مرة اقدم لك شيئاً جديداً تنتقده وترفضه

وقد قمت  بوضع شيت(target) لك بجلب كل الاسماء التي تيدأ يجروف معينه

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

و حيث اني أرى ان الموضوع أخذ من الوقت والعمل والجهد اكثر مما يستحق وليس هناك احد غيري يقوم بهذه المساعدة

لذلك أعتذر عن المتابعة في هذا الموضوع

[al7aer_2]

أشكرك أخي الكريم، ولم تأل جهداً في هذه المساعدة.
أشكرك وبارك الله فيك
على أي حال انا أردت أن يكتمل العمل بشكل  يكون مفيداً ، وهو عمل جدي فعلا ولا يوجد مثله في اليتويوب.
تابعت أكثر الفديويات لم أعثر على هذا الكود من البحث.
ودمت كريما 
انا سوف اقوم بالباقي.
شكرا لك.
واسف لازعاجك وضياع وقتك.