البحث في الموقع

السلام عليكم ورحمة الله وبركاته دالة لاستخراج اسم واحد او عدة اسماء من اسم كامل kh_Names هي دالة مطورة من الدالة kh_Name والتي تستخرج اسم واحد حسب التعيين من اسم مركب تجدها في الرابط ادناه http://www.officena.net/ib/index.php?showtopic=33289 اما هذه الدالة تستطيع من خلالها استخراج اكثر من اسم وباي ترتيب تريده (فكرة الدالة مستوحاه من مشاركة لاختي الفاضلة ام عبدالله حفظها الله حيث استخدمت الدالة السابقة kh_Name ثلات مرات لاستخراج الاسم الثلاثي ) كود الدالة: Option Explicit ' بسم الله الرحمن الرحيم " '======================================" ' دالة استخراج الاسماء من اسم مركب طويل ' iNdex1 بدلالة ترتيب الاسم '======================================" ' iNdex1 ' اختيار موقع الاسماء التي تريدها ' FullName حسب ترتبها في ' (اسم واحد او عدة اسماء) '======================================" ' وهي تقوم بإستخراج الاسماء المركبة ' للاسم الواجد ' تلقائياً حسب معايير معرفة لديها ' MyArray في متغير الجدول ' ويمكنك اضافة اي معيار آخر ' بجانب المعايير الموجودة ' مع مراعاة وجود فراغ بداية ' او نهاية المعيار '======================================" '----------------------------------------------------------------- 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 المرفق 2003 استخراج عدة اسماء من اسم كامل.rar