تجزئة الاسماء المركبة وفصلها عن الاسماء العادية

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

هناك الكثير من الأكواد  حول هذا الموضوع

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

و القدرة على اضافة بعض الأسماء الأولى للاسم المركب (عبد ,  أبو  ,  سيف  ,   جمال  الخ....)

Option Explicit
Sub split_names()
Application.ScreenUpdating = False
Dim my_st$, st1, st2
Dim last_col%
Dim my_name, i%, k%, Col%, int_col%
Dim Lr%: Lr = Cells(Rows.Count, 1).End(3).Row
Dim mon_range As Range
Dim fin_rg As Range
Range("b2").Resize(Lr - 1, 10).Clear
Dim arr: arr = _
Array("سيف", "عبد", "أبو", "ابو", "عز", "صدر", "نور")
'++++++++++++++++++++++++++++++++++++++
Rem     Array تستطيع ان تضيف اي بداية اسم مركب داخل هذا الــ
'+++++++++++++++++++++++++++++++++++++
 For i = 2 To Lr
 If Range("a" & i) = vbNullString Then GoTo Next_i
  my_st = Trim(Range("a" & i))
  my_name = Split(Trim(my_st))
  Range("b" & i).Resize(1, UBound(my_name) + 1) = my_name
Next_i:
  Next
  '==============================
 For i = 2 To Lr
   last_col = Cells(i, Columns.Count).End(1).Column
   Set mon_range = Range(Cells(i, 2), Cells(i, last_col))
   For k = 1 To last_col - 1
    If Not (IsError(Application.Match(mon_range.Cells(k), arr, 0))) Then
        st1 = mon_range.Cells(k): st2 = mon_range.Cells(k + 1)
        mon_range.Cells(k).Delete Shift:=xlToLeft
        mon_range.Cells(k) = st1 & " " & st2
    End If
   Next
 Next

   Set fin_rg = Range("a1").CurrentRegion
   Lr = fin_rg.Rows.Count
   Col = fin_rg.Columns.Count
  With fin_rg.Offset(1).Resize(Lr - 1, Col - 1).Offset(, 1)
   .Borders.LineStyle = 1: .Font.Bold = True
   .InsertIndent 1: Columns.AutoFit
   .SpecialCells(2).Interior.ColorIndex = 35
 End With
 Set mon_range = Nothing
 Set fin_rg = Nothing
 Application.ScreenUpdating = True
  '===============================
End Sub

الملف مرفق

 

 

sep_complex_names_New.xlsm

[Ali Mohamed Ali]

جزاك الله كل خير استاذ سليم

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

[مجدى يونس]

اعمال ومجهود ممتازة

[مصطفى محمود مصطفى]

الاستاذ الفاضل سليم حاصبيا

وفقكم الله اعمالكم في قمة الروعة

تحياتي لكم

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

بارك الله بك اخي مصطفى 

وهذا عمل اخر يقوم بنفس الشيء لكن بدالة معرفة UDF

الكود بداية

Option Explicit
Function Salim_Split_Name(N_name, n)
Dim x%
Dim arr: arr = _
Array("سيف", "عبد", "أبو", "ابو", "عز", _
      "صدر", "نور", "فضل")
'++++++++++++++++++++++++++++++++++++++
Rem     Array تستطيع ان تضيف اي بداية اسم مركب داخل هذا الــ
'+++++++++++++++++++++++++++++++++++++
Dim My_Col As New Collection
Dim Final_col As New Collection
Dim it, my_st, my_name
  my_st = Trim(N_name)
  my_name = Split(Trim(my_st))
 
 For x = LBound(my_name) To UBound(my_name)
  My_Col.Add my_name(x)
 Next x
 
 For x = 1 To My_Col.Count
   If Not (IsError(Application.Match(My_Col(x), arr, 0))) Then
    Final_col.Add My_Col(x) & " " & My_Col(x + 1)
    x = x + 1
   Else
    Final_col.Add My_Col(x)
  End If
 Next x
   
   If n > Final_col.Count Then
    Salim_Split_Name = ""
   Else
     Salim_Split_Name = Final_col(n)
   End If
    
    Set My_Col = Nothing: Set Final_col = Nothing
    Erase arr
End Function

نموذج عن الدالة وكيفية عملها في الملف المرفق

 

 

 

Fuction_split_name.xlsm

[ناصرالمصرى]

نشكر سيادتكم لهذا العمل الرائع جعله الله فى ميزان حسناتكم

ماذا لو أردنا ان نجعل الاسم الاول والاسم الاخير سواء ثلاثى أو رباعى أو خماسى فى خلية واحدة

نرجو الافاده عن كيفية القيام بذلك **** جزاكم الله خيرا

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

رداً على استفسار الاخ ناصر المصري حول اختيار قسمين من الاسم (الاول مع الأخير )

 يمكنك استعمال المعادلة التالية مع تحديد الارقام     X   Y   لكنها تعطي في بعض الأحيان خطأ اذا اخترت     X   Y   غير مناسبين

مثلا:  اذا اردت الاسم الأول والثاني       تضع   1  مكان X       وتضع 2 مكان   Y

       اذا اردت الاسم الأول فقط      تضع   1  مكان X       وتضع عددا كبيراً بعض الشيء (20) مكان   Y

      اذا اردت الاسم الثاني فقط      تضع   2  مكان X       وتضع عددا كبيراً بعض الشيء (20) مكان  Y

=Salim_Split_Name($A2,X) &" "& Salim_Split_Name($A2,Y)

تم وضع  UDF جديدة لاختيار اي قسمين من الاسم ( الاول مع الأخير  الاول مع الثاني   أو  الثاني مع الأخير   الخ..)

الصفحة  Salim من هذا الملف الأفضل هو استعمال هذه الدالة

 

 

 

Fuction_split_Part_name.xlsm

[ناصرالمصرى]

نشكر سيادتكم لإهتمامكم بالرد وأعتذر عن الرد فى حينه

تمت الافادة *** شاكر فضل حضرتك **** وجزاكم الله خيرا