تصفية البيانات من خلال مربع نص TextBox (بحث بالأحرف الأولى والتصفية حسب البحث)

[ياسر خليل أبو البراء]

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

إخواني الكرام

 

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

 

رابط الموضوع

 

وبناءً على طلب إخواني ، وهم يدركون أنني لا أتأخر عليهم أبداً أقدم لكم موضوع اليوم

فارتأيت (حلوة ارتأيت دي ... ) أن أخصص موضوع لهذا الأمر ، نظراً للطلب عليه ، ونظراً للفائدة المرجوة منه ، حيث أنه يسهل عملية البحث من خلال تصفية البيانات المطلوبة.

 

يعتمد الملف المرفق على مثال بسيط للتطبيق ، تم إدراج مربع نص TextBox من خلال التبويب Developer ثم من Insert اختر مربع نص TextBox من القسم ActiveX Controls

والبيانات المراد التعامل معها تبدأ من الخلية C3 وحتى آخر خلية بها بيانات...

 

إليكم إخواني الكود مع شرح مبسط للأسطر عله يفيدكم

Private Sub TextBox1_Change()
'يقوم الكود بالبحث في نطاق من خلال مربع نص ، وتصفية النتائج طبقاً للنص المدخل
'[Insert] ثم من قائمة [Developer] من خلال التبويب [TextBox] قم بإدراج مربع نص
'ثم قم بإدراجه على ورقة العمل [ActiveX Controls]  قم بالنقر على مربع النص الموجود في
'--------------------------------------------------------------------------
'تعريف المتغيرات والثوابت
    Dim LastRow As Long, RngFiltered As Range, I As Long, Arr
    Static Rng As Range
'إلغاء خاصية اهتزاز الشاشة
    Application.ScreenUpdating = False
'إلغاء الفلترة في ورقة العمل النشطة
      ActiveSheet.AutoFilterMode = False
'قيمة تظهر كل الصفوف لهذا النطاق [Static] إذا لم يكن للثابت المسمى
      If Not Rng Is Nothing Then Rng.EntireRow.Hidden = False
'تحديد آخر صف به بيانات في العمود الثالث
      LastRow = Range("C1000").End(xlUp).Row
'أي الخلية التي تسبق أول البيانات [C2] تعيين قيمة النطاق بداية من الخلية
      Set Rng = Range("C2:C" & LastRow)
'تعيين قيمة للمتغير من النوع مصفوفة ليساوي كل قيم النطاق
      Arr = Rng.Value
'إذا كان طول السلسلة النصية في مربع النص أكبر من صفر
      If Len(TextBox1.Text) >  Then
'حلقة تكرارية لصفوف النطاق
         For I = 1 To UBound(Arr, 1)
'[']إذا كان العنصر داخل المصفوفة رقمي يتم وضع علامة
             If IsNumeric(Arr(I, 1)) Then Arr(I, 1) = "'" & Arr(I, 1)
         Next I
'قيم النطاق تساوي القيم الجديدة في المصفوفة
         Rng.Value = Arr
'تصفية النطاق بشرط النص المدخل في مربع النص
         Rng.AutoFilter Field:=1, Criteria1:="=" & TextBox1.Text & "*"
      End If
'تعيين المتغير ليساوي الخلايا الظاهرة في النطاق
      Set RngFiltered = Rng.SpecialCells(xlCellTypeVisible)
'إلغاء الفلترة في ورقة العمل النشطة
      ActiveSheet.AutoFilterMode = False
'حلقة تكرارية لإعادة الأرقام للحالة الأولى بدون العلامة البادئة
      For I = 1 To UBound(Arr, 1)
          If Left(Arr(I, 1), 1) = "'" Then
             Arr(I, 1) = Mid(Arr(I, 1), 2)
           End If
      Next I
      Rng.Value = Arr
'إخفاء الصفوف للنطاق
      Rng.EntireRow.Hidden = True
'إظهار الصفوف للنطاق الذي تمت عملية التصفية على أساسه
      RngFiltered.EntireRow.Hidden = False
'إعادة تفعيل خاصية اهتزاز الشاشة
    Application.ScreenUpdating = True
End Sub

أترككم مع الملف المرفق ..

قوموا بتجربة الملف .. تم إدراج بيانات مختلفة نصوص باللغة العربية وباللغة الإنجليزية وأرقام ...

 

حمل الملف من هنا

تقبلوا تحياتي أخوكم ياسر خليل أبو البراء

[علي الشيخ]

جزاك الله خيرا أستاذ ياسر وجعله في ميزان حسناتك

[ياسر خليل أبو البراء]

وجزيت خيراً مثل ما دعوت أخي المتألق علي الشيخ

بارك الله فيك

[محمد حسن المحمد]

بسم الله الرحمن الرحيم 

الحمد لله رب العالمين والصلاة والسلام على سيد المرسلين محمّد وعلى آله وصحبه الغر الميامين وبعد:

فالشكر لله أولاً ثم لكم أخي ياسرأبو البراء الغالي ومنتداكم الكريم أن كنت سبباً ولو كان بسيطاً في نشركم لهذا الموضوع الذي أرجو الله ان يكون نافعاً

لشريحة كبيرة من الناس...لكم الفضل في ذلك

تقبلوا تحيات أخيكم محمد بن حسن المحمد أبو يوسف

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

[ياسر خليل أبو البراء]

بسم الله الرحمن الرحيم 

الحمد لله رب العالمين والصلاة والسلام على سيد المرسلين محمّد وعلى آله وصحبه الغر الميامين وبعد:

فالشكر لله أولاً ثم لكم أخي ياسرأبو البراء الغالي ومنتداكم الكريم أن كنت سبباً ولو كان بسيطاً في نشركم لهذا الموضوع الذي أرجو الله ان يكون نافعاً

لشريحة كبيرة من الناس...لكم الفضل في ذلك

تقبلوا تحيات أخيكم محمد بن حسن المحمد أبو يوسف

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

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

جزيت خيراً أخي الغالي ابو يوسف على مرورك العطر وكلماتك الطيبة

تقبل تحياتي

[ابو محمد نصري]

جزاك الله خيرا أستاذ أبو البراء

[جلال محمد]

اخي الكريم 

ياسر أبو البراء

السلام عليكم 

جزاك الله خيرا اخي الكريم 

عمل أكثر من رائع 

بارك الله فيك ... ونفع بك الله الناس 

رائع جدا .....

[ياسر خليل أبو البراء]

الأخ الفاضل أبو محمد نصري

الأخ العزيز جلال محمد الغائب عن الأعين الحاضر في القلب

 

بارك الله فيكم وجزيتم خير الجزاء

[Yasser Fathi Albanna]

الله عليك يا حبيبى الغالى يا أ / ياسر

ستظل دائما وأبدا متألق وتقدم كل ما هو جديد ومفيد

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

[ياسر خليل أبو البراء]

الله عليك يا حبيبى الغالى يا أ / ياسر

ستظل دائما وأبدا متألق وتقدم كل ما هو جديد ومفيد

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

وجزيت خير الجزاء أخي الحبيب الباشمهندس ياسر

ومشكور عىل مرورك العطر وعلى دعائك الطيب المبارك

تقبل تحياتي

[احمد ابوزيزو]

الاخ المحترم /  ياسر خليل أبو البراء

جزاك الله خيرا  ووفاك اجرا  وجعله لك زخرا

[أيمن ابراهيم]

[احمد ابوزيزو]

ارجو التطبيق علي الملف المرفق

 

بحث و تصفيه.rar

[محمد حسن المحمد]

السيد أحمد أبو زيزو المحترم:

قمت بنسخ كود الأستاذ المحترم ياسر أبو البراء إلى ملفك وقد تم بحمد الله المطلوب

لا أتطاول على قامات العلماء الكرام بل أنهل من معينهم وأرجو الله تعالى أن يمتعنا بعلمهم فليعذرني أخي الحبيب ياسر أبو البراء

لم آت بجديد بل غيرت بما يمكن تغييره في المعادلة .

مع تحياتي وشكري واعتذاري إن بدر مني أي خطأ...

بحث وتصفيه.rar

تم تعديل مايو 30, 2015 بواسطه محمد حسن المحمد

[أسامة البراوى]

 فكرة جميلة يا استاذ ياسر

[ياسر خليل أبو البراء]

الأخ الكريم أحمد زيزو

جزيت خيراً على دعائك الطيب ..

هل الملف الذي قدمه لك الكبير أبو يوسف أدى الغرض ؟

 

الأخ محمد حسن أبو يوسف

جزيت خيراً ..وهو دا الشغل ..اللي نتعلمه نفيد بيه غيرنا تسلم وربنا يبارك فيك

 

الأخ أيمن

أما آن لك أن تغير اسم الظهور للغة العربية

مشكور على مرورك العطر

 

الأخ الغالي والأستاذ الكبير أسامة البراوي

نجمك سيسطع في سماء المنتدى ..بارك الله لنا فيك

وفي انتظار مساهماتك وموضوعات جديدة ومفيدة للأخوة الأعضاء ..يا ما في الجراب يا براوي

[أيمن ابراهيم]

الأخ الكريم أحمد زيزو

جزيت خيراً على دعائك الطيب ..

هل الملف الذي قدمه لك الكبير أبو يوسف أدى الغرض ؟

 

الأخ محمد حسن أبو يوسف

جزيت خيراً ..وهو دا الشغل ..اللي نتعلمه نفيد بيه غيرنا تسلم وربنا يبارك فيك

 

الأخ أيمن

أما آن لك أن تغير اسم الظهور للغة العربية

مشكور على مرورك العطر

 

الأخ الغالي والأستاذ الكبير أسامة البراوي

نجمك سيسطع في سماء المنتدى ..بارك الله لنا فيك

وفي انتظار مساهماتك وموضوعات جديدة ومفيدة للأخوة الأعضاء ..يا ما في الجراب يا براوي

مشرفنا الغالي الاستــــاذ ياسر خليل

طلبـــاتك أوامر

تم تعديل اسم الظهر كما اقترحت ، اشكرك

[ياسر خليل أبو البراء]

جزيت خيراً أخي الغالي أيمن إبراهيم على الاستجابة لطلبي

والله اسمك بالعربي منور أكتر

[احمد ابوزيزو]

الاستاذ / المحترم محمد حسن المحمد

الف شكر علي اهتمامك .

..هذا تماما المطلوب

[احمد ابوزيزو]

الاخ المحترم/

ياسر خليل أبو البراء

شكرا علي الاهتمام

شكرا علي مجهودكم الرائع

[محمد حسن المحمد]

الاخ المحترم/

ياسر خليل أبو البراء

شكرا علي الاهتمام

شكرا علي مجهودكم الرائع

الأخ أحمد زيزو المحترم : السلام عليكم ورحمة الله وبركاته

لا شكر على واجب ....بل الشكر موصول للأستاذ ياسر خليل أبو البراء الذي علمني إياها

تقبل تحياتي السلام عليكم.

[محي الدين ابو البشر]

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

اساتذتي ابحث عن هكذا امر منذ مدة واخيرا  وصلت وشكرا للاستاذ ياسر حليل على جهوده

اررجو ان يسمح لي بسؤال

اذا كان يمكن اضافة تكست بوكس ثاني للبحث عن الكنية ليصبح البحث عن الاسم والكنية

هذا امر والامر الاخر اذا بالإمكان الانتقال من تكست بوكس 1 إلى تكست بوكس 2 عن طريق enter or tab ومن تكست بوكس 2 إلى تكست بوكس 1 بنفس الطريقة

[محي الدين ابو البشر]

استاذتي السلام عليكم

لاحظت عند استعمال Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) عوضا عن change()

عند الانتقال إلى   textbox2 ينسى التصفية التي حدثت في textbox1

اكرمكم الله هل هناك حل

دمتم بالف خير

[محي الدين ابو البشر]

استاذتي السلام عليكم

لاحظت عند استعمال Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) عوضا عن change()

عند الانتقال إلى   textbox2 ينسى التصفية التي حدثت في textbox1

اكرمكم الله هل هناك حل

دمتم بالف خير

تم الحل

مشكورين

[saad abed]

أستاذ ياسر خليل

اسال الله ان يمن عليك بالصحة والعافيه

وان يبارك لك في اولادك

وفقك الله في كل حياتك الدنيويه

مواضيعك كلها ممتازه

تم تعديل سبتمبر 9, 2015 بواسطه سعد عابد