البحث بتجاهل أنواع الألف (ا أ إ آ) و حرفي (ه، ة) و (ي ى)

[صالح حمادي]

السلام عليكم

لاحظت كثرة الأسئلة حول كيفية البحث بتجاهل أنواع الألف (ا أ إ آ) فقررت إنشاء موضوع أشرح فيه هذه الطريقة مع وضع مثال بسيط.

مثلا عندما أبحث عن كلمة أحمد يكفي أن أكتب: احمد فتظهر الأسماء المكتوبة بالهمزة و بغير همزة.

و غيرها مع باقي الأنواع.

الكود المستعمل:

   Dim rst  As String, x As String, CrtTxt As String
   Dim i As Integer, RC As Integer
   Dim homm As String
   homm = Me.t2.Text
   Me.t3.Value = homm
  
    CrtTxt = "Like ""*" & Me.t3 & "*"""
      
       If InStr(1, Me.t3, "أ") > 0 Or InStr(1, Me.t3, "ا") > 0 Or InStr(1, Me.t3, "إ") > 0 Or InStr(1, Me.t3, "آ") > 0 Or InStr(1, Me.t3, "ى") > 0 Or InStr(1, Me.t3, "ي") > 0 Or InStr(1, Me.t3, "ه") > 0 Or InStr(1, Me.t3, "ة") > 0 Then
          
          CrtTxt = CrtTxt & " or [الكود] Like ""*" & Replace(Me.t3, "ا", "أ") & "*"""
          CrtTxt = CrtTxt & " or [الكود] Like ""*" & Replace(Me.t3, "ا", "آ") & "*"""
          CrtTxt = CrtTxt & " or [الكود] Like ""*" & Replace(Me.t3, "ا", "إ") & "*"""
          
          CrtTxt = CrtTxt & " or [الكود] Like ""*" & Replace(Me.t3, "ة", "ه") & "*"""
          CrtTxt = CrtTxt & " or [الكود] Like ""*" & Replace(Me.t3, "ه", "ة") & "*"""
          
          CrtTxt = CrtTxt & " or [الكود] Like ""*" & Replace(Me.t3, "ى", "ي") & "*"""
          CrtTxt = CrtTxt & " or [الكود] Like ""*" & Replace(Me.t3, "ي", "ى") & "*"""
          
          CrtTxt = CrtTxt & " or [الكود] Like ""*" & Replace(Replace(Me.t3, "ا", "أ"), "ي", "ى") & "*"""
          CrtTxt = CrtTxt & " or [الكود] Like ""*" & Replace(Replace(Me.t3, "ا", "آ"), "ي", "ى") & "*"""
          CrtTxt = CrtTxt & " or [الكود] Like ""*" & Replace(Replace(Me.t3, "ا", "إ"), "ي", "ى") & "*"""
                 
          CrtTxt = CrtTxt & " or [الكود] Like ""*" & Replace(Replace(Me.t3, "ا", "أ"), "ى", "ي") & "*"""
          CrtTxt = CrtTxt & " or [الكود] Like ""*" & Replace(Replace(Me.t3, "ا", "آ"), "ى", "ي") & "*"""
          CrtTxt = CrtTxt & " or [الكود] Like ""*" & Replace(Replace(Me.t3, "ا", "إ"), "ى", "ي") & "*"""
       
          CrtTxt = CrtTxt & " or [الكود] Like ""*" & Replace(Replace(Me.t3, "ا", "أ"), "ة", "ه") & "*"""
          CrtTxt = CrtTxt & " or [الكود] Like ""*" & Replace(Replace(Me.t3, "ا", "آ"), "ة", "ه") & "*"""
          CrtTxt = CrtTxt & " or [الكود] Like ""*" & Replace(Replace(Me.t3, "ا", "إ"), "ة", "ه") & "*"""
                 
          CrtTxt = CrtTxt & " or [الكود] Like ""*" & Replace(Replace(Me.t3, "ا", "أ"), "ه", "ة") & "*"""
          CrtTxt = CrtTxt & " or [الكود] Like ""*" & Replace(Replace(Me.t3, "ا", "آ"), "ه", "ة") & "*"""
          CrtTxt = CrtTxt & " or [الكود] Like ""*" & Replace(Replace(Me.t3, "ا", "إ"), "ه", "ة") & "*"""
       End If
rst = ("SELECT * FROM [جدول1] where [الكود] " & CrtTxt & ";")
Me.salah.Form.RecordSource = rst
Me.salah.Requery

و هذا مثال على ذلك:

البحث بتجاهل أنواع الألف.rar

وهذا رابط فديو شرحت به البرنامج:

 

[محمد سلامة]

جزاك الله خيرا استاذ. صالح حماد 

ممكن اعرف اسم او رابط البرنامج المستخدم في تسجيل الفيديو الخاص بك

شكرا جدا لحضرتك

[محمد احمد لطفى]

جزاك الله خيرا ممكن نسخة 2003

[Hamdi Edlbi-khalf]

مرحباً

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

و فائدة هذه الطريقة هي توحيد البيانات عند تصدير الجدول إلى إكسل .

لكن  طريقتكم  أكثر إبداعاً و احترافية ..

سلمت يداك .

تم تعديل أكتوبر 24, 2018 بواسطه Khalf

[صالح حمادي]

في ٢٤‏/١٠‏/٢٠١٨ at 16:59, محمد سلامة said:

ممكن اعرف اسم او رابط البرنامج المستخدم في تسجيل الفيديو الخاص بك

FastStone Capture

و الرابط هو: http://www.faststone.org/download.htm

[النجاشي]

10 دقائق مضت, صالح حمادي said:

FastStone Capture

و الرابط هو: http://www.faststone.org/download.htm

بارك الله فيك وزادك الله علما استاذنا الفاضل صالح حمادي 

جزاك الله خير على ما تقدمه لنا و جعله الله بميزان حسناتك واعطاك الله الصحه والعافيه

ابداع جميل جدا

تحياتي اليك

 

[صالح حمادي]

2 دقائق مضت, ابو زاهر said:

بارك الله فيك وزادك الله علما استاذنا الفاضل صالح حمادي 

جزاك الله خير على ما تقدمه لنا و جعله الله بميزان حسناتك واعطاك الله الصحه والعافيه

ابداع جميل جدا

آمين و لك بالمثل صديقي ابو زاهر

[النجاشي]

استاذي@صالح حمادي كيف اذا بدي استخدم حقل البحث t2 لحقلين  الاسم والرقم اي  اكون ابحث بالاسم او بالرقم 

الان يبحث بالاسماء روعه 

لقد عملت هيك هل صحيح قبل السطرين الاخيرين من الكود

rst = ("SELECT * FROM [جدول1] where [الرقم] " & CrtTxt & ";")
ووضعت المعيار بالاستعلام

تم تعديل أكتوبر 28, 2018 بواسطه ابو زاهر

[محمد سلامة]

2 ساعات مضت, صالح حمادي said:

FastStone Capture

و الرابط هو: http://www.faststone.org/download.htm

شكرا جزيلا استاذ صالح