دالة لاستخراج اسم واحد او عدة اسماء من اسم كامل

[عبدالله باقشير]

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

 

دالة لاستخراج اسم واحد او عدة اسماء من اسم كامل

kh_Names

 

 

هي دالة مطورة من الدالة  kh_Name

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

http://www.officena.net/ib/index.php?showtopic=33289

 

اما هذه الدالة تستطيع من خلالها استخراج اكثر من اسم وباي ترتيب تريده

 

(فكرة الدالة مستوحاه من مشاركة لاختي الفاضلة ام عبدالله حفظها الله

حيث استخدمت الدالة السابقة kh_Name ثلات مرات لاستخراج الاسم الثلاثي )

 

كود الدالة:

Option Explicit



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

'======================================"
'   دالة استخراج الاسماء من اسم مركب طويل
'       iNdex1 بدلالة ترتيب الاسم
'======================================"
'              iNdex1
'    اختيار موقع الاسماء التي تريدها
'     FullName  حسب ترتبها في
'       (اسم واحد او عدة اسماء)
'======================================"
'    وهي تقوم بإستخراج الاسماء المركبة
'            للاسم الواجد
'    تلقائياً حسب  معايير معرفة لديها
'        MyArray  في متغير الجدول
'      ويمكنك اضافة اي معيار آخر
'        بجانب المعايير الموجودة
'      مع مراعاة وجود فراغ بداية
'           او نهاية المعيار
'======================================"


'-----------------------------------------------------------------


Function kh_Names(FullName As String, ParamArray iNdex1()) As String
Dim i As Integer
Dim kh_Split, MyArray, Ar
Dim Kh_String As String, Sn As String, Re As String
    
On Error GoTo Err_Kh_Names

    '======================================
    MyArray = Array("عبد ", "أبو ", "ابو ", "آل " _
    , " الله", " الدين", " الإسلام", " الاسلام", " الحق")
    '======================================
    Sn = Application.WorksheetFunction.Trim(FullName)
    For Each Ar In MyArray
        Re = Replace(Ar, " ", "^")
        Sn = Replace(Sn, Ar, Re)
    Next
    '======================================
    kh_Split = Split(Sn, " ", , vbTextCompare)
    
    On Error Resume Next
    For i = 0 To UBound(iNdex1)
        Kh_String = Kh_String & " " & kh_Split(iNdex1(i) - 1)
    Next
    On Error GoTo 0
    
    Kh_String = Replace(Trim(Kh_String), "^", " ")
    kh_Names = Kh_String
    
    Exit Function

Err_Kh_Names:
     kh_Names = ""
End Function

المرفق 2003

استخراج عدة اسماء من اسم كامل.rar

 

[عادل ابوزيد]

استاذنا العزيز القدير الغالى عبد الله باقشير

دائماً اعمالك نور تنير عقولنا جعلها الله فى ميزان حسناتك وزادك من علمه وفضله

[أم عبد الله]

أستاذنا القدير العلاّمة / عبد الله باقشير

 

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

 

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

[عبدالله باقشير]

  في 19‏/9‏/2013 at 20:26, عادل ابوزيد said:

استاذنا العزيز القدير الغالى عبد الله باقشير

دائماً اعمالك نور تنير عقولنا جعلها الله فى ميزان حسناتك وزادك من علمه وفضله

 

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

 

تقبلوا تحياتي وشكري

[الـعيدروس]

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

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

تقبل مروري

[عبدالله باقشير]

  في 19‏/9‏/2013 at 20:39, أم عبد الله said:

أستاذنا القدير العلاّمة / عبد الله باقشير

 

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

 

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

 

اختي الفاضلة نشاطك في المنتدى ملحوظ ما شاء الله عليك

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

 

تقبلوا تحياتي وشكري

[عبدالله باقشير]

  في 19‏/9‏/2013 at 20:52, عباد said:

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

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

تقبل مروري

 

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

 

تقبلوا تحياتي وشكري

[دغيدى]

أخى الفاضل / عبدالله 

أثابكم الله على ما تقدمه من علم

[عبدالله باقشير]

  في 19‏/9‏/2013 at 21:29, دغيدى said:

أخى الفاضل / عبدالله 

أثابكم الله على ما تقدمه من علم

 

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

 

تقبلوا تحياتي وشكري

[الشهابي]

أستاذنا الكبير / عبدالله باقشير

ما شاء الله تبارك الله

أستاذي عودتنا أن نرى لك دائما شيء جديد من أعمالكم 

يستفيد منها الجميع 

الله لا يحرمنا منك ويطول لنا في عمرك ويجعل لك في كل خطوة سلامة

تفبل تحياتي وتقديري

[محمدي عبد السميع]

ماشاء الله

عمل ولا أروع

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

[أبو عبد الملك السوفي]

السلام عليكم

مبدع دائما أستاذ عبد الله وفقك الله

[حمادة باشا]

دالة ممتازة ومتعددة الإستخدامات ستريحنا من عناء التكويد في البحث عن الأسماء

جزاك الله كل خير يا أستاذ/ عبدالله

[عبدالله باقشير]

  في 20‏/9‏/2013 at 06:07, الشهابي said:

أستاذنا الكبير / عبدالله باقشير

ما شاء الله تبارك الله

أستاذي عودتنا أن نرى لك دائما شيء جديد من أعمالكم 

يستفيد منها الجميع 

الله لا يحرمنا منك ويطول لنا في عمرك ويجعل لك في كل خطوة سلامة

تفبل تحياتي وتقديري

 

جزاكم الله خيرا وبارك واثابكم بدعائكم واعطاكم بمثله اضعاف مضاعفة

تقبلوا تحياتي وشكري

[عبدالله باقشير]

  في 20‏/9‏/2013 at 06:08, محمدي عبد السميع said:

 

ماشاء الله

عمل ولا أروع

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

 

 

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

 

تقبلوا تحياتي وشكري

[عبدالله باقشير]

  في 20‏/9‏/2013 at 08:28, عبد السلام زاوي said:

السلام عليكم

مبدع دائما أستاذ عبد الله وفقك الله

 

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

 

تقبلوا تحياتي وشكري

[عبدالله باقشير]

  في 21‏/9‏/2013 at 10:28, حمادة باشا said:

دالة ممتازة ومتعددة الإستخدامات ستريحنا من عناء التكويد في البحث عن الأسماء

جزاك الله كل خير يا أستاذ/ عبدالله

 

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

 

تقبلوا تحياتي وشكري

[دغيدى]

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

[عبدالله باقشير]

  في 21‏/9‏/2013 at 20:56, دغيدى said:

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

 

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

تقبلوا تحياتي وشكري

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

ما شاء الله ما اروع مشاركاتك استاذ عبدالله

[أ . وهبي]

بارك الله فيك ؛ و جزاك الله خيراً .....

[عبد الفتاح كيرة]

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

لعل الله يوفقنى بنقلها للأكسيس

إن شاء الله