تجزئة الاسم الرباعي

[ابو عبدالرحمن البغدادي]

السلام عليكم

عندي خانة تحتوي على الاسم الرباعي واللقب ، المطلوب تجزئة الاسم الرباعي واللقب الى خانات ، (الاسم الاول ، الاسم الثاني ، الاسم الثالث ، الاسم الرابع ، اللقب ) وكما مبين بالملف المرفق

 

تجزئة الاسم الرباعي.rar

تم تعديل أكتوبر 20, 2015 بواسطه ابو عبدالرحمن البغدادي

[توكل]

أخي الكريم جرب الملف المرفق وهو من كتابة الأخ المبدع عبد الله باقشير جزاه الله خيراً.

وإن شاء الله يكون هو المطلوب

تقبل تحياتي

تجزئية الاسم الراباعي.rar

[ابو عبدالرحمن البغدادي]

الاسم عليكم

المعادلة لم تعمل على ملفي - ارفق ملف يرجى تطبيق المعادلة أو الكود عليه

 

تجزئة الاسم الرباعي123.rar

[توكل]

أخي المعادلة تعمل على نفس الملف المرسل إذا أردت أن تعمل على ملفك إنسخ الكود للملف المطلوب أو إذا أردت أن تعمل في كل الملفات إنسخ الكود إلى personal file في الإكسل

لك تحياتي

[ابو عبدالرحمن البغدادي]

السلام عليكم

النتيجة التي تظهر نتيجة عند اضافة الكود هي (0) رقم صفر ، ممكن معادلة بدل الكود

[توكل]

أخي الكريم يجب إضغفة أرقام من 1 إلى 5 تحت الإسم الأول والثاني وهكذا حتى يتم عمل المعادلة بشكل كامل 

 

[ابو عبدالرحمن البغدادي]

تمام - جزيت خيرا

 

[خالد الرشيدى]

السلام عليكم

جزاك الله خيراً استاذى الفاضل / توكل .. لاثراء الموضوع ها هى طريقة اخرى بإستخدام المعادلات

 اخى الكريم قم بوضع المعادلة التالية فى الخلية B2 ثم السحب يساراً

=SUBSTITUTE(TRIM(MID(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(" "&$G2;" "&"الدين";"#الدين");" "&"الله";"#الله");"عبد"&" ";"عبد#");"ابو"&" ";"ابو#");" ";REPT(" ";200));COLUMN(A1)*200;200));"#";" ")

 تجزئة الاسم الرباعي.rar

  - لست بحاجه الى كتابة الارقام 1 الى 5 -

تم تعديل أكتوبر 20, 2015 بواسطه خالد الرشيدى

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

وهذا حل آخر إثراءً للموضوع

الدالة المعرفة

Function Kh_Names(FullName As String, ParamArray Index1()) As String
    Dim I As Integer
    Dim Kh_Split, MyArray, Arr
    Dim Kh_String As String, SN As String, RE As String

    On Error GoTo Err_Kh_Names

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

    SN = Application.WorksheetFunction.Trim(FullName)
    For Each Arr In MyArray
        RE = Replace(Arr, " ", "^")
        SN = Replace(SN, Arr, RE)
    Next

    Kh_Split = Split(SN, " ", , vbTextCompare)

    On Error Resume Next
    For I = 0 To UBound(Index1)
        Kh_String = Kh_String & " " & Kh_Split(Index1(I) - 1)
    Next
    On Error GoTo 0

    Kh_String = Replace(Trim(Kh_String), "^", " ")
    Kh_Names = Kh_String

    Exit Function

Err_Kh_Names:
    Kh_Names = ""
End Function

 

Split Full Names UDF Function.rar

أخي الحبيب توكل

لم أطلع على حلك إلا بعد أن قدمت المشاركة الخاصة بي فأعتذر عن تكرار الحل .. إذا أنها تقريباً نفس الدالة المعرفة المستخدمة

تقبل تحياتي