تدقيق الاسماء

[جروان]

تحية

اعتذر عن غيابي و عدم التواصل في الفترة السابقة بسبب الانشغال الشديد ارجو المساعدة في طريقة لتدقيق الاسماء حيث يوجد موضوع مشابه ولاكن لا يلبي المطلوب على الرابط التالي http://www.officena.net/ib/index.php?showtopic=37732&hl=ط§ظ„ط§ط³ظ…ط§ط،#entry203118

و المطلوب موضح بالمرفق

شكرا

تدقيق الاسماء.rar

[عبدالله المجرب]

اليك هذه الدالة المعرفة

Function MyFunTest(MyVal1 As Range, MyVal2 As Range) As String

For Each C In Split(MyVal2, " ")

Y = Y + 1

For Each C1 In Split(MyVal1, " ")

E = E + 1

If C = C1 Then R = R + 1: K = K & C & " و "

Next

Next

E = E / Y

Select Case E

       Case Is = R

       MyFunTest = "متطابق 100%"

       Case Else

        MyFunTest = "متطابق في " & Left(K, Len(K) - 2)

End Select

End Function

[عبدالله المجرب]

اليك المرفق

تدقيق الاسماء.rar

[الخالدي]

عمل اقل ما يقال عنه ممتاز ورائع

بارك الله فيك استاذ عبدالله

[عبدالله المجرب]

سلمت لنا استاذ الخالدي على هذا التشجيع الكريم

هذا بعض ما عندكم

[جروان]

واستاذي عبدالله المجرب اعزك الله

والله حل خطير جدا جدا جدا اللة يجزيك الخير عن كل حرف بملوين و اكثر ، اسف لكثر طلباتي في المرفق يوجد بعض الملاحظات ارجو الاطلاع عليها و اذا لم اثقل عليك ارجو شرح للكود

و شكرا

[جروان]

واستاذي عبدالله المجرب اعزك الله

والله حل خطير جدا جدا جدا اللة يجزيك الخير عن كل حرف بملوين و اكثر ، اسف لكثر طلباتي في المرفق يوجد بعض الملاحظات ارجو الاطلاع عليها و اذا لم اثقل عليك ارجو شرح للكود

و شكرا

تدقيق الاسما1ء.rar

[عبدالله المجرب]

السلام عليكم

تم التعديل كما تم اضافة خيار عدم التطابق

إستبدل الكود السابق بهذا

Function MyFunTest(MyVal1 As Range, MyVal2 As Range) As String

For Each C1 In Split(MyVal1)

E = E + 1

Next

For Each C In Split(MyVal2)

Y = Y + 1

For Each C1 In Split(MyVal1)

If C = C1 Then R = R + 1: K = K & C & " و ": Exit For

Next

Next

Select Case R

	   Case Is = E

	   MyFunTest = "متطابق 100%"

	   Case Is = Empty

	   MyFunTest = " غير متطابق "

	   Case Else

	    MyFunTest = "متطابق في " & Left(K, Len(K) - 2)

End Select

End Function

[جروان]

[تحية

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

لي طلب اخير في شرح الكود ان امكن و ان تظهر مسج فقط في حال عدم التطابق اسف لكثرة الطلبات