دالة تجزئة الاسماء من اسم طويل

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

السلام عليكم

 

Option Explicit



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

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


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

Function kh_Name(Name As String, Optional kh_index = 1) As String
Dim kh_ind As Integer
Dim kh_Split, MyArray, Ar
Dim Kh_String As String, Sn As String, Re As String, kh_Split_index As String, Kh_Rep As String
    
On Error GoTo Err_Kh_Name

    kh_ind = Val(kh_index)
    If kh_ind = 0 Then kh_ind = 1
    '======================================
    MyArray = Array("عبد ", "أبو ", "ابو ", "آل " _
    , " الله", " الدين", " الإسلام", " الاسلام", " الحق")
    '======================================
    Sn = Application.WorksheetFunction.Trim(Name)
    For Each Ar In MyArray
        Re = Replace(Ar, " ", "^")
        Sn = Replace(Sn, Ar, Re)
    Next
    '======================================
    Kh_String = Sn
    kh_Split = Split(Kh_String, " ", , vbTextCompare)
    kh_Split_index = kh_Split(kh_ind - 1)
    Kh_Rep = Replace(kh_Split_index, "^", " ")
    kh_Name = Kh_Rep
    
    Exit Function

Err_Kh_Name:
     kh_Name = ""
End Function

تجزئة الاسماء من اسم طويل.rar

[قصي]

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

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

أخي الحبيب / خبور خير

عمل رائع بارك الله فيك وجعله في ميزان حسناتك .

تحياتي

أبو عبدالله

[أبوســـارة1973]

مازلت تبهرنا بإنجازاتك الكبيرة با كبير

أستاااااااذ

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

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

الله أكبر ولله الحمد

حققت ما لم يستطع الآخرون تحقيقه

وحطمت عالم الأكواد بإبداعاتك

بارك الله لنا فيك وزادك علماً وحلماً أيها المبدع دائماً

تم تعديل يوليو 21, 2010 بواسطه YasserKhalil

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

ماشاء الله

عمل ولاأروع

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

[الزرقطوني]

سبحان الله

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

ما شاء الله

اللهم يارب أجعل مقام أخينا خبور خير الجنة إن شاء الله يا رب

[الحسامي]

السلام عليكم

اخي الحبيب خبور خير

ما شاء الله وتبارك الله اعمال لن نجدها إلا عندك تفيدنا وتثرينا

وجعلها الله في ميزان حسناتك ان شاء الله تعالى

عماد الحسامي

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

السلام عليكم

الاخ الفاضل/ قصي------ حفظه الله

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

الاخ الفاضل/ ابو عبدالله ------ حفظه الله

اكرمك الله في الدارين

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

الاخ الفاضل/ ابو سارة------ حفظه الله

اكرمك الله في الدارين

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

الاخ الفاضل/ ياسر خليل------ حفظه الله

اكرمك الله في الدارين

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

الاخ الفاضل/ محمدي عبد السميع ------ حفظه الله

اكرمك الله في الدارين

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

الاخ الفاضل/ ezzarqtouni------ حفظه الله

اكرمك الله في الدارين

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

الاخ الفاضل/ الحسامي------ حفظه الله

اكرمك الله في الدارين

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

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

[أسد سوف]

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

تم تعديل يوليو 21, 2010 بواسطه أسد سوف

[قصي]

السلام عليكم

اخي الحبيب خبور خير

ما شاء الله وتبارك الله اعمال لن نجدها إلا عندك تفيدنا وتثرينا

وجعلها الله في ميزان حسناتك ان شاء الله تعالى

عماد الحسامي

جعلها الله في ميزان حسناتك ان شاء الله تعالى

تم تعديل يوليو 21, 2010 بواسطه قصي

[اوفيس 2003]

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

[myyasser]

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

[هشام كوكب]

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

[MAHMOUD ALI YOUSSEF]

السلام عليكم

اكواد قمة في الروعة

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