Yasser Fathi Albanna قام بنشر نوفمبر 9, 2015 قام بنشر نوفمبر 9, 2015 السلام عليكم ورحمة الله وبركاته أحبائى وأساتذتى وأعضاء هذا الصرح العلمى الهائل الذى مهما قدمت له لن أوفيه حقه فيما تعلمت منه الفترة الماضية وبعد قدمت من قبل موضوع بعنوان معادلة بحث جميلة جدا على الرابط ولكن بالمعادلات اليوم أقدم لكم نفس الفكرة ولكن بالأكواد الأكواد المستخدمة الكود الأول فى حدث الشييت : Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Cells(2, 2)) Is Nothing Then: names_by_letters End Sub والكود الثانى يوضع ب Module Sub names_by_letters() Dim myRange As Range Dim i As Integer Dim x As Range i = 2 lr = Cells(Rows.Count, 1).End(xlUp).Row Range("c2:c" & lr).ClearContents Set myRange = Range("a2:a" & lr) For Each x In myRange If Mid(x, 1, 1) = [b2] Then Cells(i, 3).Value = x i = i + 1 End If Next x End Sub أرجوا أن يستفاد منه الجميع والله ولى التوفيق Find By VBA Code.rar 6
Yasser Fathi Albanna قام بنشر نوفمبر 9, 2015 الكاتب قام بنشر نوفمبر 9, 2015 2 دقائق مضت, abouelhassan said: شكر وتقدير باحترام من اخيك تقبل خالص تحياتى وتقديرى وإحترامى أخى الحبيب abouelhassan لمرورك العطر 1
ياسر خليل أبو البراء قام بنشر نوفمبر 9, 2015 قام بنشر نوفمبر 9, 2015 أخي الغالي المتميز ياسر البنا بارك الله فيك وجزيت خيراً على هذا الإبداع واصل بلا فواصل 1
عبد العزيز البسكري قام بنشر نوفمبر 9, 2015 قام بنشر نوفمبر 9, 2015 السّلام عليكم و رحمة الله و بركاته بارك الله فيك أستاذي و أخي الغالي " ياسر فتحي البنّا " جزئيات و أكواد مهمّة تتحفنا بها بين الحين و الآخر .. واصل بلا فواصل و إنّا لك متتبّعون جزاك الله خيرًا و زادها بميزان حسناتك أخوك / عبد العزيز البسكري 1
Yasser Fathi Albanna قام بنشر نوفمبر 9, 2015 الكاتب قام بنشر نوفمبر 9, 2015 34 دقائق مضت, ياسر خليل أبو البراء said: أخي الغالي المتميز ياسر البنا بارك الله فيك وجزيت خيراً على هذا الإبداع واصل بلا فواصل اخى الحبيب الغالى أستاذى ومعلمى الذى أكن له كل تقدير وإحترام والذى دائما يشجعنى الأستاذ الفاضل / ياسر خليل شرفت بمرورك دائما على موضوعاتى 27 دقائق مضت, عبد العزيز البسكري said: السّلام عليكم و رحمة الله و بركاته بارك الله فيك أستاذي و أخي الغالي " ياسر فتحي البنّا " جزئيات و أكواد مهمّة تتحفنا بها بين الحين و الآخر .. واصل بلا فواصل و إنّا لك متتبّعون جزاك الله خيرًا و زادها بميزان حسناتك أخوك / عبد العزيز البسكري أخى الحبيب الغالى / عبد العزيز الذى يسعدنى ويشرفنى دائما مجرد مرورة على موضوع لى يعلم الله أنى أحبك فى الله أدام الله بيننا المحبة والإخلاص جزيت خيرا على مرورك الكريم ودعائك الطيب 1
مختار حسين محمود قام بنشر نوفمبر 9, 2015 قام بنشر نوفمبر 9, 2015 Sub names_by_letters() Dim myRange As Range Dim i As Integer Dim x As Range i = 2 lr = Cells(Rows.Count, 1).End(xlUp).Row Range("c2:c" & lr).ClearContents Set myRange = Range("a2:a" & lr) For Each x In myRange If UCase(Mid(x, 1, 1)) = [b2] Or LCase(Mid(x, 1, 1)) = [b2] Then Cells(i, 3).Value = x i = i + 1 End If Next x End Sub مشكور أخى ياسر بارك الله فيك اضافة صغيرة لو كان حرف البحث صمول مش هيعمل البحث لذلك يصبح الكود الرئيسى كما سبق تحياتى 1
Yasser Fathi Albanna قام بنشر نوفمبر 9, 2015 الكاتب قام بنشر نوفمبر 9, 2015 اخى الحبيب / مختار إضافة رائعة جزيت بها خير يسعدنى ويشرفنى دائما مرورك
KHMB قام بنشر نوفمبر 10, 2015 قام بنشر نوفمبر 10, 2015 (معدل) السلام عليكم ورحمة الله جزاك الله خير المهندس ياسر فتحي جزاك الله خير أستاذ مختار علي التعديل بخصوص الحروف الإنجليزية بأنه يقبل الحروف الكبيره والصغيره. وهذا نفس الملف بخصوص قبول حروف البحث في الخلية B2 الكبيره والصغيره فهو يقوم بتحويل الحروف سوى حرف او كلمة كاملة من حرف صغير إلي كبير فهو متواضع ولكنة ليس بقدر حلك الرائع . فقط لإثراء الموضوع وتعدد الحلول. Find By VBA Code.rar تم تعديل نوفمبر 10, 2015 بواسطه KHMB إضافة حروف البحث في الخلية B2 1
عمرو عبد الحليم قام بنشر نوفمبر 10, 2015 قام بنشر نوفمبر 10, 2015 شكرا لكم جميعا عمل رائع لكن هل من الممكن ان يكون البحث في اكثر من عمود لهذا الملف وشكرا Find Salim + Yasser.rar
إبراهيم ابوليله قام بنشر نوفمبر 10, 2015 قام بنشر نوفمبر 10, 2015 Sub names_by_letters() Dim myRange As Range Dim i As Integer Dim x As Integer x = 2 LR = Cells(Rows.Count, 1).End(xlUp).Row Range("c2:c" & LR).ClearContents Set myRange = Range("a2:a" & LR) For i = 2 To LR If InStr(1, Cells(i, "A"), [B2], vbTextCompare) Then Cells(x, 3).Value = Cells(i, 1).Value x = x + 1 End If Next i End Sub اخى ياسر البنا مشكورا على الكود الجميل ده بارك الله فيك واسمح لى بالاضافه بحث باى حرف من الاسم مع عدم اشتراط تفعيل caps lock تقبل تحياتى 3
سليم حاصبيا قام بنشر نوفمبر 10, 2015 قام بنشر نوفمبر 10, 2015 ممتاز اخي ياسر والان جرب ان تستبدل سطر الشرط IF بهذا السطر و لاحظ النتيجة If InStr(UCase(x.Value), UCase([b2].Value)) > 0 Then 3
عمرو عبد الحليم قام بنشر نوفمبر 10, 2015 قام بنشر نوفمبر 10, 2015 للرفع رفع الله قدركم Find Salim + Yasser.rar
Yasser Fathi Albanna قام بنشر نوفمبر 10, 2015 الكاتب قام بنشر نوفمبر 10, 2015 13 ساعات مضت, إبراهيم ابوليله said: Sub names_by_letters() Dim myRange As Range Dim i As Integer Dim x As Integer x = 2 LR = Cells(Rows.Count, 1).End(xlUp).Row Range("c2:c" & LR).ClearContents Set myRange = Range("a2:a" & LR) For i = 2 To LR If InStr(1, Cells(i, "A"), [B2], vbTextCompare) Then Cells(x, 3).Value = Cells(i, 1).Value x = x + 1 End If Next i End Sub اخى ياسر البنا مشكورا على الكود الجميل ده بارك الله فيك واسمح لى بالاضافه بحث باى حرف من الاسم مع عدم اشتراط تفعيل caps lock تقبل تحياتى أخى الحبيب / إبراهيم شرفت بمرورك العطر وعلى هذه الإضافة الجميلة جزاك الله خيرا تقبل تحياتى 11 ساعات مضت, سليم حاصبيا said: ممتاز اخي ياسر والان جرب ان تستبدل سطر الشرط IF بهذا السطر و لاحظ النتيجة If InStr(UCase(x.Value), UCase([b2].Value)) > 0 Then أستاذى ومعلمى القدير / سليم دائما رائع ومتميز شكرا لك وعلى إضافتك شرفت بمرورك تقبل خالص تحياتى وتقديرى 20 ساعات مضت, KHMB said: السلام عليكم ورحمة الله جزاك الله خير المهندس ياسر فتحي جزاك الله خير أستاذ مختار علي التعديل بخصوص الحروف الإنجليزية بأنه يقبل الحروف الكبيره والصغيره. وهذا نفس الملف بخصوص قبول حروف البحث في الخلية B2 الكبيره والصغيره فهو يقوم بتحويل الحروف سوى حرف او كلمة كاملة من حرف صغير إلي كبير فهو متواضع ولكنة ليس بقدر حلك الرائع . فقط لإثراء الموضوع وتعدد الحلول. Find By VBA Code.rar الله ينور على شعلة النار جزاك الله خيرا أخى الحبيب KHMB على إثراء الموضوع
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.