مطلوب كود تجاهل حروف ( ة ه ي ى أ إ آ ز ذ ) في اكسس

[mahmoudlabana]

انا عملت نموذج بحث من نموذج فرعي محتاج كود يخلي البحث يتجاهل حروف ال ( ة ه ي ى أ إ آ ز ذ  ) في البحث يعني لو بحث ب يمني يظهر يمنى و يمني و هكذا :) 
 

[محمد أبوعبدالله]

تفضل اخي الكريم

تحياتي

[mahmoudlabana]

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

[محمد أبوعبدالله]

تفضل اخي الكريم مثال اخر

zaReplaceALL&Search.rar

ان واجهت مشكلة ارفق مثال ليتم التطبيق عليه

ولك الشكر

تحياتي

[صالح حمادي]

السلام عليكم

جرب هذا الرابط:

 

[sandanet]

آمل أن ينفعك هذا المثال

test111.mdb

[محمد أبوعبدالله]

وهذا افضل مثال يقوم ببحث شامل عن المتشابهات لاستاذنا الفاضل @محمد طاهر

أاآإ

ةته

ىي

ئءؤو

Search.rar

تحياتي

[mahmoudlabana]

مثال Search.rar فيه مشكلة على فكرة و هي انك لو ضفت مسافة بعد الاسم مش هتضاف لازم تكتب اسم تاني و ترجع ما بين الاسمين و تضيف مسافة 

دا المثال يا شباب هو بردو بيبحث بالتشابهات لكن تشابهات الكلمات مش الحروف يا ريت حد يعدله ويضيف تشابه الحروف ا أ ى ي ة ه ز ذ 

adv find test.rar

تم تعديل نوفمبر 27, 2019 بواسطه mahmoudlabana

[محمد أبوعبدالله]

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

تم تعديل المثال من البداية وباختصار ايضاً وتم دمج كود تجاهل المسافات

تم اضافة

Function changesearch(Mytxt) As String
   Dim tempstr As String
   tempstr = Nz(Mytxt, "")
   tempstr = ReplaceChar(tempstr, "أإآاء")
   tempstr = ReplaceChar(tempstr, "ةته")
   tempstr = ReplaceChar(tempstr, "ىي")
   tempstr = ReplaceChar(tempstr, "وؤ")
   changesearch = tempstr
End Function


Private Function ReplaceChar(W As String, c As String) As String
   Dim R As Byte
   Dim S As String, i As String
   For R = 1 To Len(W)
      i = Mid(W, R, 1)
      If InStr(c, i) > 0 Then
         S = S & "[" & c & "]"
      Else
         S = S + i
      End If
   Next R
   ReplaceChar = S
End Function

وفي حدث عند الخروج تم اضافة

Private Sub Mysearch_Exit(Cancel As Integer)
   Dim newsearch As String
      newsearch = changesearch(Me.Mysearch)
      M = "SELECT * FROM Customer WHERE CusName Like '*" & PartOfName(newsearch, 1) & "*" & PartOfName(newsearch, 2) & "*" & PartOfName(newsearch, 3) & "*" & PartOfName(newsearch, 4) & "*" & PartOfName(newsearch, 5) & "*" & PartOfName(newsearch, 6) & "*';"
      Me.CustomerFind_subform.Form.RecordSource = M
      Me.Mysearch.SetFocus

End Sub

UP-adv find test_2.rar

تحياتي

[mahmoudlabana]

شكرا جزيلا اخي الكريم بس ناقص حرف ال ز و ال ذ لو ممكن :) 

[محمد أبوعبدالله]

3 ساعات مضت, mahmoudlabana said:

شكرا جزيلا اخي الكريم بس ناقص حرف ال ز و ال ذ لو ممكن 🙂

تفضل اخي الكريم

tempstr = ReplaceChar(tempstr, "ذز")

ليكون هكذا

Function changesearch(Mytxt) As String
   Dim tempstr As String
   tempstr = Nz(Mytxt, "")
   tempstr = ReplaceChar(tempstr, "أإآاء")
   tempstr = ReplaceChar(tempstr, "ةته")
   tempstr = ReplaceChar(tempstr, "ىي")
   tempstr = ReplaceChar(tempstr, "وؤ")
   
   tempstr = ReplaceChar(tempstr, "ذز")
   
   changesearch = tempstr
End Function

تحياتي