دالة استخراج اسم الابن أو الأب أو الجد أو اللقب

[مختار حسين محمود]

السلام عليكم ورحمة الله وبركاته
بداية نشكر الأستاذ عبدالله باقشير الذى قدم لنا الدالة الشهيرة Kh_Father_Name
لاستخراج اسم الاب كاملا من اسم الشخص  العربى و ذلك بمساعدة الدالة Kh_Father_Replace

ثانيا أقدم لكم الدالة المستحدثة MokhtarFamily  تشبه دالة الاستاذ عبدالله فى العمل والخواص إلا إنها أشمل
نوعا ما حيث تستطيع الدالة أن تقوم باستخراج الآتى
 1- اسم الابن
 2- اسم الاب
3- اسم الاب كاملا
4- اسم الجد
5- اسم الجد كاملا
6- اسم العائلة منفردا  

الصورة العامة للدالة
 MokhtarFamily (StrgName,NameNum,AcceptSingle)

تلاحظ أن الدالة تتكون من 3 بارامتر StrgName   NameNum   AcceptSingle

البارامتر الاول نص اجبارى يحمل اسم الشخص الذى تتعامل معه

البارامتر  الثانى عدد اجبارى من 1 الى 4
  1    لاستخراج اسم الابن
  2    لاستخراج اسم الاب
  3   لاستخراج اسم الجد
  4   لاستخراج اسم العائلة أو اللقب

البارامتر  الثالث اختيارى بين قيمتين هما  False و True
فى كل الأحوال ناتج الدالة يكون اسما منفردا  
باستثناء  True  فى استخراج اسم الأب أو الجد فقط  حيث تأتى باسم الأب أو الجد كاملا   

كود الدالة مع التعليقات

Option Explicit

Public Function MokhtarFamily(ByVal StrgName As String, ByVal NameNum As Integer, Optional AcceptNext As Boolean) As String
' Author  : Mokhtar Hussein
' Release : 5 - 11 - 2016  Assuit Eygypt
' The MokhtarFamily is a new User Defined Function returns son's name or Father's name
' or Grandfather's name or Family's name of Arab person's name bases on a specific number.
' The MokhtarFamily udf takes into consideration the Arab complex names
' The Syntax :
' MokhtarFamily(StrgName,NameNum,AcceptNext)
' The MokhtarFamily function syntax has these named arguments:
' 1 - StrgName : Required String
'     - The person's name which you are useing.
' 2 - NameNum  : Required Integer
'     - 1 to return the son's name.
'     - 2 to return the Father's name
'     - 3 to return the Grandfather's name
'     - 4 to return the Family's Name .
' 3 - AcceptNext : Optional False or True
'     - False to return all names in a Single form
'     - True to return Father's name and Grandfather's name of fourfold Arab person's name ln a full form
'--------------------------------------------------------------------------------------------------------------------------------------
' الاعلان عن المتغيرات
Dim TempName As String, SonName As String, Fname As String, GfName As String, FamilyName As String, Ipos As Integer
Dim Sn As String, OtherNames As String, xName As String, xxName As String, xxxName As String, xxxxName As String, Arr, itm
' أضف هنا المقطع الأول ملحقا بفراغ أوالثانى مسبوقا بفراغ والتى تتكون منها الأسماء المركبة مثل عبد الرحمن أو المعتصم بالله
Arr = Array("أبو ", "ابو ", "عبد ", "آل ", " الله", " الدين", " الإسلام", " الاسلام", " الهدى", " الحق", " النصر", " العهد", " النور", " بالله", " الزهراء", " كلثوم")
' ErrorHandlerفى حالة حدوث خطأ اذهب الى السطر الذى يبدأ بـ
 On Error GoTo ErrorHandler
'   جعل الدالة حساسة لأى تغير فى الخلية التى تعمل عليها
' بمعنى أى تغير فى الخلية يتبعه تغير ناتج الدالة مباشرة
Application.Volatile True
' التعامل مع الاسماء المركبة
' Arr حلقة تكرارية على كل اسم مركب فى المصفوفة
For Each itm In Arr
    ' استبدال الفراغ بين المقطعين بشرطة واعتبارهما اسم واحد
    TempName = Replace(itm, " ", "_")
    ' وضع الشرطة فى كل اسم مركب يوجد باسم الشخص
    ' باستبدال أى اسم مركب به فراغ
    ' باسم مركب به شرطة بين مقطعيه
    StrgName = Replace(StrgName, itm, TempName)
    ' الانتقال الى الاسم التالى
Next itm
' بالخطوة السابقة صار الاسم المركب اسما واحدا
' الخطوة التالية فحص المتغير الذى يحمل اسم الشخص
' هل المتغير فارغ أم أن هذا المتغير به اسم شخص
' اذا كان المتغير الذى يحمل اسم الشخص فارغا
If IsEmpty(StrgName) Then
   'فاذهب الى السطر
   GoTo ErrorHandler
Else   ' وان لم يكن المتغير فارغا يتم
   ' تخزين اسم الشخص فى متغير جديد
   ' مع حذف الفراغات فقط يمين و يسار اسم الشخص
   ' مع بقاء الفراغات الداخلية بين كل اسم واسم
   ' Trim وذلك يتم باستخدام الدالة
     Sn = Trim(StrgName)
End If
' بالخطوة السابقة صار اسم الشخص جاهزا
' لاستخــراج الأسماء منه على التوالى منه
'وجود فراغ أو فراغات فى اسم الشخص معناه
'أن اسم الشخص مكون من اسمين فرعيين أوأكثر
' وعدم وجود الفراغ دليل على أنه اسم واحد

' =====  استخراج الاسم الأول أى اسم الابن =====
' البحث عن موضع الفراغ الأول فى اسم الشخص
' InStr        وهذا يتم باستخدام الدالة
Ipos = InStr(Sn, " ")
' اذا كان الموضع = صفر
If Ipos = 0 Then
   ' فإن اسم الشخص بدون فراغ وهذا يعنى
   '  أنّ اسم الشخص مكون فقط من اسم واحد
   ' وبالتالى المتغير الذى يحمل الاسم الاول
   ' تكون قيمته = اســــــــم الشخص
      xName = Sn
   ' أيضا المتغير الذى يحمل باقى الأسماء
   ' كاسم الأب و الجد و العائلة = لا شىء
   OtherNames = vbNullString
   ' اسم الابن قد يكون مركبا وبداخله شرطة
   ' للتخلص من الشرطة نضع بدلا منها  فراغ
   SonName = Replace(Trim(xName), "_", " ")
Else ' وان لم يكن الموضع = صفر فإن
  ' هذا معناه أن اسم الشخص به فراغ
  ' ومعناه أنه مكون من اسمين أو أكثر
  ' اسم الابن = الحروف التى تقع يسار اسم الشخص
  ' انتهاء بالحرف الذى يسبق  الفراغ  مباشرة
  xName = Left(Sn, Ipos - 1)
  ' أيضا المتغير الذى يحمل باقى الأسماء
  ' يساوى كل الحروف التى  تقع يمين الفراغ مباشرة
  'هذا المتغير نستخرج منه باقى الأسماء على التوالى
  OtherNames = Trim(Right(Sn, Len(Sn) - Ipos))
  ' استبدال الشرطة فى اسم الابن المركب بفراغ
  SonName = Replace(Trim(xName), "_", " ")
End If

' =====  استخراج الاسم الثانى أى اسم الأب =====
'  استخراج الاسم الثانى أو اسم الأب  بنفس الكيفية السابقة
'  لكن من المتغير الذى يحمل الأسماء التى تقع بعد اسم الابن
Ipos = InStr(OtherNames, " ")
If Ipos = 0 Then
   xxName = OtherNames
   OtherNames = vbNullString
   Fname = Replace(Trim(xxName), "_", " ")
Else
   xxName = Left(OtherNames, Ipos - 1)
   OtherNames = Trim(Right(OtherNames, Len(OtherNames) - Ipos))
   Fname = Replace(Trim(xxName), "_", " ")
End If
' =====  استخراج الاسم الثالث أى اسم الجد =====
'  استخراج الاسم الثالث أو اسم الجد  بنفس الكيفية السابقة
'  لكن من المتغير الذى يحمل الأسماء التى تقع بعد اسم الأب
Ipos = InStr(OtherNames, " ")
If Ipos = 0 Then
   xxxName = OtherNames
   OtherNames = vbNullString
   GfName = Replace(Trim(xxxName), "_", " ")
Else
   xxxName = Left(OtherNames, Ipos - 1)
   OtherNames = Trim(Right(OtherNames, Len(OtherNames) - Ipos))
   GfName = Replace(Trim(xxxName), "_", " ")
End If
' =====  استخراج الاسم الرابع أى اسم العائلة =====
'  استخراج الاسم الرابع أو اسم العائلة بنفس الكيفية السابقة
'  لكن  من المتغير الذى يحمل الأسماء التى تقع بعد اسم الجد
Ipos = InStr(OtherNames, " ")
If Ipos = 0 Then
   xxxxName = OtherNames
   OtherNames = vbNullString
   FamilyName = Replace(Trim(xxxxName), "_", " ")
Else
   xxxxName = Left(OtherNames, Ipos - 1)
   OtherNames = Trim(Right(OtherNames, Len(OtherNames) - Ipos))
   FamilyName = Replace(Trim(xxxxName), "_", " ")
End If

' =====  النتائج المختلفة للدالة =====
' اذا كان المتغير رقما ويساوى 1
 If IsNumeric(NameNum) And NameNum = 1 Then
   ' ناتج الدالة = اسم الابن :الخروج من الدالة
    MokhtarFamily = SonName: Exit Function           ' اسم الابن
' أيضا اذا  كان المتغير رقما ويساوى 4
ElseIf IsNumeric(NameNum) And NameNum = 4 Then    ' اسم العائلة أو اللقب
    ' ناتج الدالة = اسم العائلة :الخروج من الدالة
   MokhtarFamily = FamilyName: Exit Function
End If
' اذا كان المتغير لا يساوى True
If AcceptNext <> True Then
' و كان المتغير رقما ويساوى 2
If IsNumeric(NameNum) And NameNum = 2 Then
'ناتج الدالة = اسم الاب فقط :الخروج من الدالة
   MokhtarFamily = Fname: Exit Function
' واذا كان المتغير رقما ويساوى 3
ElseIf IsNumeric(NameNum) And NameNum = 3 Then
' ناتج الدالة = اسم الجد فقط :الخروج من الدالة
   MokhtarFamily = GfName: Exit Function
End If: End If
' اذا كان المتغير لا يساوى False
If AcceptNext <> False Then
' و كان المتغير رقما ويساوى 2
If IsNumeric(NameNum) And NameNum = 2 Then
'ناتج الدالة = اسم الاب كاملا باضافةالجد والعائلة ويفصل بينهم فراغ  :الخروج من الدالة
   MokhtarFamily = Fname & Space(1) & GfName & Space(1) & FamilyName: Exit Function
' واذا كان المتغير رقما ويساوى 3
ElseIf IsNumeric(NameNum) And NameNum = 3 Then
'  ناتج الدالة = اسم الجد كاملا باضافةالعائلة ويفصل بينهما فراغ
   MokhtarFamily = GfName & Space(1) & FamilyName: Exit Function
End If: End If

' اعتبارا ناتج الدالة لا شىء فى حالة حدوث أخطاء
ErrorHandler: MokhtarFamily = vbNullString

End Function

المرفق يوضح   
 كيفية استخدام الدالة مباشرة على الخلايا  و كيفية استدعاء الدالة بالكود

 

أتمنى أن تكون الدالة مفيدة وتنال اعجابكم

مع خالص تحياتى

 

Mokhtar Family New UDF.rar

[سليم حاصبيا]

بعد اذن الاخ مختار

جرب هذا الملف

Split_names.rar