دوال اكسيل استخراج اسم الأب من اسم الطالب

[alfa]

الأستاذ البطل السيناوى

عندما كتبت اسم
نور الدين يحيى

جاءت النتيجة
الدين يحيى
و هذا طبعا خطأ

الحاصل أن مثل هذا الهدف
لايمكن الحصول عليه بمعادلة
لكن هناك دالة مخصصة
من ابتكار أخى و معلمى الأستاذ خبور
تكفلت ب 99 فى المئة من النتائج الصحيحة
و هذا هو الكود العبقرى الخاص بها

Option Explicit

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

'       دالة استخراج اسم ولي الأمر         "
'========================================"
'     True =    kh_First  اذا كان        "
'        او اي رقم غير الصفر              "
'     تقوم باستخراج الاسم الاول            "
'========================================"
'    يامكانية معالجة الاسم المركب الاول      "
'    تلقائياً حسب  معايير معرفة لديها      "
'      Kh_Father_Replace  في الدالة       "
'       ويمكنك اضافة اي معيار آخر         "
'        بجانب المعايير الموجودة             "
'          MyArray  في المتغير              "
'      مع مراعاة وجود فراغ بداية
'           او نهاية المعيار
'========================================"
'-----------------------------------------------------------------

Function Kh_Father_Name(ByVal Name As String, Optional kh_First As Boolean) As String
Dim KhString As String, Kh_Mid As String, Kh_Rep  As String
Dim KhMyNo As Integer

    On Error GoTo Err_Kh_Father_Name

    If IsEmpty(Name) Then GoTo Err_Kh_Father_Name
    KhString = Kh_Father_Replace(Trim(Name)) & " "
    KhMyNo = InStr(1, KhString, " ", 1)
    If kh_First Then Kh_Mid = Trim(Mid(KhString, 1, KhMyNo)) Else _
    Kh_Mid = Trim(Mid(KhString, KhMyNo, Len(KhString)))
    Kh_Rep = Replace(Kh_Mid, "^", " ")
    Kh_Father_Name = Kh_Rep
    
    Exit Function

Err_Kh_Father_Name:
     Kh_Father_Name = ""
End Function
Private Function Kh_Father_Replace(ByVal Kh_Sub As String) As String
Dim MyArray, Ar
Dim Sn As String, Re As String
'====================================================
' يمكنك اضافة اي معيار آخر هنا بجانب المعايير الموجودة

MyArray = Array("عبد ", "أبو ", "ابو ", "آل ", " الله" _
    , " الدين", " الإسلام", " الاسلام", " الحق")

'====================================================
Sn = Kh_Sub
For Each Ar In MyArray
    Re = Replace(Ar, " ", "^")
    Sn = Replace(Sn, Ar, Re)
Next
Kh_Father_Replace = Sn
End Function

الملف بالمرفقات