اضافة بسيطة على كود فصل اسم الاب عن اسم الابن المركب

[عمر الجزاوى]

السلام عليكم ورحمة الله وبركاته بعد اذن استاذتنا الكرام بعد البحث في المنتدى وجدت هذا الكود للعلامة الأستاذ عبدالله بقشير ويقوم الكود بفص اسم الاب عن اسم التلميذ وان كان الاسم مركب  وعند تجربة الكود يقوم بفصل اسم الاب عن اسم التلميذ وهو اسم مركب الا في حالاتين وهو اسم نور الهدى واسم فاطمة الزهراء وهما اسمين مركبين المفروض ياخذ من بداية اسم احمد محمد عبدالرؤوف ام باقى الاسماء فهم تمام المطلوب اضافة اسم الهدى واضافة اسم الزهراء الى الكود وجزاكم الله خير

استخراج اسم الاب من الاسم المركب.xlsm

[محمد هشام.]

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

جرب هدا 

Function Father_Name(Name As Variant, Optional x As Variant) As Variant
    Dim tmp As String, s As String, n As Integer, d As Integer, j As Integer
    
    tmp = Trim(Name.Value)
    j = Len(tmp)
    s = " "
    
    If InStr(1, tmp, s) = 0 Then
        Father_Name = ""
        Exit Function
    End If

    Select Case True
        Case Left(tmp, 9) = "نور الهدى"
            n = InStr(10, tmp, s) + 1
            Father_Name = Mid(tmp, n, j)
            Exit Function
            
        Case Left(tmp, 13) = "فاطمة الزهراء"
            n = InStr(14, tmp, s) + 1
            Father_Name = Mid(tmp, n, j)
            Exit Function
    End Select

    If Not IsError(x) Then
        n = 1
        For r = 2 To x
            n = InStr(n, tmp, s) + 1
        Next r
        d = InStr(n, tmp, s) + 1
        Father_Name = Mid(tmp, d, j)
    Else
        n = InStr(1, tmp, s) + 1
        d = InStr(n, tmp, s) + 1
        
        If Mid(tmp, 1, 3) Like "عبد*" Or Mid(tmp, 1, 3) Like "أبو*" Or _
           Mid(tmp, n, 5) Like "الله" Or Mid(tmp, n, 5) Like "الدين" Then
            Father_Name = Mid(tmp, d, j)
        Else
            Father_Name = Mid(tmp, n, j)
        End If
    End If
End Function

 

استخراج اسم الاب من الاسم المركب.xlsm

[عمر الجزاوى]

استاذنا انا عايز ندخل التعديل على هذا النطاق 

   If Mid(K, 1, 4) = "عبد " Or _
      Mid(K, 1, 4) = "أبو " Or _
      Mid(K, 1, 4) = "ابو " Or _
      Mid(K, N, 5) = "الله " Or _
      Mid(K, N, 6) = "الدين " Then

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

انا اسف على الازعاج

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

بعد اذن استاذنا الفاضل محمد هشام 

كذلك كود الاستاذ العلامة  عبدالله باقشيرلا يتعامل مع  اسماء اخرى مثل المعتصم بالله    الواثق بالله ام كلثوم   ام احمد  ام الخير ام الهناء واحيانا بالهمز واحيانا لا  وغيرها من الاسماء  

والقاعدة هي اظافة الاسم الثابت بمعنى  مثلا فاطمة الزهراء فنضيف الى الكود الزهراء فقط لانه ثابت واي اسم ياتي قبل الزهراء سيتعامل معه الكود  كذلك نور الهدى او سيف الهدى فنضيف الى الكود اسم الهدى فقط وهكذا

كذلك يمكنك اظافة اي اسم اد جد اسم جديد

تعديل الكود

Function Father_Name(Name As String, Optional x As Integer = 2) As String
    Dim K As String
    Dim S As String
    Dim N As Integer
    Dim d As Integer
    Dim M As Integer
    Dim r As Integer
    
    K = Trim(Name)
    M = Len(K)
    S = " "
    
    If InStr(1, K, S, 1) = 0 Then
        Father_Name = ""
        Exit Function
    End If
    
    If x > 1 Then
        N = 1
        For r = 2 To x
            d = InStr(N, K, S, 1) + 1
            If d = 1 Then
                Father_Name = ""
                Exit Function
            End If
            N = d
        Next
        d = InStr(N, K, S, 1) + 1
        If d = 1 Then
            Father_Name = ""
            Exit Function
        End If
        Father_Name = Mid(K, d, M)
    Else
        N = InStr(1, K, S, 1) + 1
        d = InStr(N, K, S, 1) + 1
        If d = 1 Then
            Father_Name = ""
            Exit Function
        End If
        If Mid(K, 1, 4) = "عبد " Or _
           Mid(K, 1, 4) = "أبو " Or _
           Mid(K, 1, 4) = "ابو " Or _
           Mid(K, N, 5) = "الله " Or _
           Mid(K, N, 6) = "الدين " Or _
           Mid(K, 1, 5) = "الهدى " Or _
           Mid(K, 1, 6) = "كلثوم " Or _
           Mid(K, 1, 7) = "الزهراء " Or _
           Mid(K, 1, 3) = "أم " Or _
           Mid(K, 1, 2) = "ام " Or _
           Mid(K, N, 5) = "بالله " Then
            Father_Name = Mid(K, d, M)
        Else
            Father_Name = Mid(K, N, M)
        End If
    End If
End Function

الملف

استخراج اسم الاب من الاسم المركب1.xlsm

[عمر الجزاوى]

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

هو ده المطلوب استاذ عبدالله

جزاكم الله خيرا انت والاستاذ محمد هشام 

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

[أ / محمد صالح]

بارك الله فيكم جميعا

ولإثراء الموضوع وترتيب الكود وتنظيمه يمكننا استعمال هذه الدالة بعد التحسين

تم جعل الأسماء المركبة بدلالة الكلمة الأولى في مصفوفة منفصلة عن الأسماء المركبة بدلالة الكلمة الثانية

يمكن احضار الاسم الأول بتمرير رقم 1 في المعامل الثاني للدالة

ويمكن احضار اسم الاب برقم 2 أو بدون المعامل الثاني

Function SplitName(Name As String, Optional part As Integer = 2) As String
    Dim K As String, S As String, N As Integer, M As Integer, FirstName As String
    Dim startsNames As Variant, endsNames As Variant, sName As Variant
    
    K = Trim(Name):    M = Len(K):    S = " "
    
    ' مصفوفة الأسماء المركبة التي تبدأ بكلمات معينة
    startsNames = Array("عبد", "أبو", "ابو", "ام", "أم", "ذو", "امرؤ", "سيف", "زين", "روح", "عين")
    
    ' مصفوفة الأسماء المركبة التي تنتهي بكلمات معينة
    endsNames = Array("الله", "الدين", "بالله", "الزهراء", "الهدى")
    
    If InStr(1, K, S, 1) = 0 Then
        SplitName = Name
        Exit Function
    End If
    
        ' التحقق من الأسماء المركبة التي تبدأ بكلمات معينة
        For Each sName In startsNames
            If Left(K, Len(sName) + 1) = sName & " " Then
                FirstName = Left(K, InStr(Len(sName) + 2, K, S, 1) - 1)
                SplitName = IIf(part = 1, FirstName, Mid(K, Len(FirstName) + 1, Len(K)))
                Exit Function
            End If
        Next
        
        ' التحقق من الأسماء المركبة التي تنتهي بكلمات معينة
        For Each sName In endsNames
            If InStr(1, K, sName, vbTextCompare) > 0 Then
                 FirstName = Left(K, InStr(1, K, sName, vbTextCompare) + Len(sName) - 1)
                 SplitName = IIf(part = 1, FirstName, Mid(K, Len(FirstName) + 1, Len(K)))
                Exit Function
            End If
        Next
        
        ' إذا لم يكن الاسم مركبًا، عرض الاسم الأول فقط
        FirstName = Left(K, InStr(1, K, S, 1) - 1)
        SplitName = IIf(part = 1, FirstName, Mid(K, Len(FirstName) + 1, Len(K)))
End Function

بالتوفيق

[عمر الجزاوى]

ما شاء الله ثلاث مشاركات وكلها عبقرية جزاكم الله خير الجزاء وجعله الله فى ميزان حسناتكم جمعيا