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

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

قام بنشر

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

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

 

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

 

رابط الموضوع

 

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

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

 

يعتمد الملف المرفق على مثال بسيط للتطبيق ، تم إدراج مربع نص 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

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

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

:welcomeani: 

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

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

  • Like 12
قام بنشر

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

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

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

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

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

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

قام بنشر

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

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

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

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

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

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

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

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

تقبل تحياتي

  • Like 1
قام بنشر

اخي الكريم 

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

السلام عليكم 

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

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

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

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

قام بنشر

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

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

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

قام بنشر

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

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

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

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

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

تقبل تحياتي

قام بنشر (معدل)

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

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

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

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

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

بحث وتصفيه.rar

تم تعديل بواسطه محمد حسن المحمد
  • Like 2
قام بنشر

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

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

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

 

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

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

 

الأخ أيمن

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

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

 

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

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

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

  • Like 1
قام بنشر

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

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

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

 

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

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

 

الأخ أيمن

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

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

 

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

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

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

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

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

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

  • Like 1
قام بنشر

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

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

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

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

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

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

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

  • Like 1
  • 3 months later...
قام بنشر

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

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

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

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

هذا امر والامر الاخر اذا بالإمكان الانتقال من تكست بوكس 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

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

دمتم بالف خير

تم الحل

مشكورين

قام بنشر (معدل)

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

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

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

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

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

تم تعديل بواسطه سعد عابد
  • Like 1

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