اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

الردود الموصى بها

السلام عليكم

 

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

  • Like 1
رابط هذا التعليق
شارك

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

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

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

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

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

تم تعديل بواسطه YasserKhalil
رابط هذا التعليق
شارك

سبحان الله

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

ما شاء الله

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

رابط هذا التعليق
شارك

السلام عليكم

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

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

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

عماد الحسامي

رابط هذا التعليق
شارك

السلام عليكم

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

رابط هذا التعليق
شارك

السلام عليكم

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

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

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

عماد الحسامي

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

تم تعديل بواسطه قصي
رابط هذا التعليق
شارك

  • 1 year later...
زائر
هذا الموضوع مغلق.
×
×
  • اضف...

Important Information