فصل أسماء

[أحمد مرهج]

أنا جديد في استخدام الاكسل

في الملف المرفق اريد فصل الاسماء في حقول جديدة

ارجو المساعدة

excel.rar

[ياسر العربى]

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

جرب  الكود دا

Sub TEST()
    Range("B1:D" & Range("B1:D1").End(xlDown).Row).ClearContents
    Columns("A:A").TextToColumns Destination:=Range("B1"), DataType:=xlFixedWidth, _
                                 FieldInfo:=Array(Array(0, 1), Array(4, 1), Array(9, 1)), TrailingMinusNumbers:= _
                                 True
End Sub

 

excel.rar

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

السلام عليكم

بالفعل افاكر نيرة

وذكاء بالاستخدام

أدامك الله

[ياسر العربى]

مشكور اخي الكريم محي الدين ابو البشر 

اليك كود اخر يفى بالغرض

Sub splitText()
    Dim splitVals As Variant
    Dim totalVals As Long
    For Each xx In Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row)
        splitVals = Split(xx.Value, " ")
        totalVals = UBound(splitVals)
        Range(Cells(xx.Row, xx.Column + 1), Cells(xx.Row, xx.Column + 1 + totalVals)).Value = splitVals
    Next
End Sub

 

excel.rar

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

بارك الله فيك أخي الحبيب ياسر العربي ..

هل فكرت بالأسماء المركبة؟ جرب أن تضع الاسم "عبد الله أحمد عبد السلام"

 

[ياسر العربى]

بصراحه انا ريحت دماغى وجبتلك دا

دالة معرفة

Function kh_Names(FullName As String, ParamArray iNdex1()) As String
Dim i As Integer
Dim kh_Split, MyArray, Ar
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 Ar In MyArray
        Re = Replace(Ar, " ", "^")
        Sn = Replace(Sn, Ar, 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

وكتابة الدالة كما يلي

=kh_Names($A1;COLUMN()-1)

كما بالمرفق

دا كود ليك ياجميل من فترة وليك اكواد كتير خاصة بموضوع الاسماء المركبة

وربنا يسهل واعمل انا كود مختلف عنهم باذن الله 

تقبل تحياتي

 

excel.rar

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

بارك الله فيك أبو العربي ..وجزيت خيراً على مساهماتك الرائعة والممتعة والمبدعة

إنت تعرف إني ممكن أفتكر أي كود عملته .. Absolutely لا .. كلا وألف كلا  = 1001 كلا !!

لما قلت لي إني عندي الكود بحثت عنه ووجدت الملف التالي عندي .. بس أبسولوتلي زهاااااااااااايمر على طول الخط

تقبل تحياتي

 

Split Compound Names UDF Function.rar

[ياسر العربى]

تصدق مش هو 

مهو احمد زي الحاج احمد

مهي نتيجة الدالة او قيمتها مباشر هي هي

تسلم ياريس

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

السلام عليكم

ما شاء الله

[أبو حنــــين]

السلام عليكم

لاثراء الموضوع هذا كود آخر لكن مشكلة الاسماء ذات المحق : عبد ، أبو ، ابو ، آل . . . . . تبقى قائمة

Sub Name_Cel()

Dim iName As Variant, _
    i     As Integer, _
    X     As Integer
'--------------------------
Application.ScreenUpdating = False

    Range("B1:K" & Range("A1:K1").End(xlDown).Row).ClearContents
        For X = 1 To Cells(Rows.Count, "A").End(xlUp).Row
        iName = Split(Range("A" & X).Text, " ")
        For i = LBound(iName, 1) To UBound(iName, 1)
        Cells(X, i + 2) = Replace(iName(i), "", "")
    Next: Next
    
Application.ScreenUpdating = True

End Sub