السلام عليكم
Option Explicit
' بسم الله الرحمن الرحيم "
'======================================"
' دالة استخراج الاسماء من اسم مركب طويل
' kh_index بدلالة ترتيب الاسم
'======================================"
' kh_index
' اذا كانت مهملة او نصاً او صفرا
' تقوم باستخراج الاسم الاول
'======================================"
' وهي تقوم بإستخراج الاسماء المركبة
' للاسم الواجد
' تلقائياً حسب معايير معرفة لديها
' MyArray في متغير الجدول
' ويمكنك اضافة اي معيار آخر
' بجانب المعايير الموجودة
' مع مراعاة وجود فراغ بداية
' او نهاية المعيار
'======================================"
'-----------------------------------------------------------------
Function kh_Name(Name As String, Optional kh_index = 1) As String
Dim kh_ind As Integer
Dim kh_Split, MyArray, Ar
Dim Kh_String As String, Sn As String, Re As String, kh_Split_index As String, Kh_Rep As String
On Error GoTo Err_Kh_Name
kh_ind = Val(kh_index)
If kh_ind = 0 Then kh_ind = 1
'======================================
MyArray = Array("عبد ", "أبو ", "ابو ", "آل " _
, " الله", " الدين", " الإسلام", " الاسلام", " الحق")
'======================================
Sn = Application.WorksheetFunction.Trim(Name)
For Each Ar In MyArray
Re = Replace(Ar, " ", "^")
Sn = Replace(Sn, Ar, Re)
Next
'======================================
Kh_String = Sn
kh_Split = Split(Kh_String, " ", , vbTextCompare)
kh_Split_index = kh_Split(kh_ind - 1)
Kh_Rep = Replace(kh_Split_index, "^", " ")
kh_Name = Kh_Rep
Exit Function
Err_Kh_Name:
kh_Name = ""
End Function
تجزئة الاسماء من اسم طويل.rar