بحث عن الاخوات فى ملف اكسل

**خالد الشاعر** · يوليو 16, 2022

هل يوجد طريقة لمعرفة اسماء الاخوات بملف اكسل

و هل يوجد ماكرو

لتحديد الاخوة الذين لهم نفس اسم الاب

شكرا

ميدو63 · يوليو 19, 2022

يفضل وضع جدول دائما للعمل عليه ...هناك كود استخدمة ولا اتذكر مصدرة تجدة ادناه

وبعد اضافتة للاكسيل شيت لا تنسى حفظ الجدول بصيغة الماكرو ..وبعدها هذة معادلة توضع بالخلية المراد فصل اسم الاب بها وهى والخلية (B5) هى الخلية التى بها الاسم كاملا

=@Kh_Father_Name($B5)

ولا تنسى قراءة ماهو مذكور بالكود ليتم فصل الاسم بشكل سليم

والكود هو:-

Option Explicit

'         بسم الله الرحمن الرحيم            "
'         ********************           "

'       دالة استخراج اسم ولي الأمر         "
'========================================"
'     True =    kh_First  اذا كان        "
'        او اي رقم غير الصفر              "
'     تقوم باستخراج الاسم الاول            "
'========================================"
'    يامكانية معالجة الاسم المركب الاول      "
'    تلقائياً حسب  معايير معرفة لديها      "
'      Kh_Father_Replace  في الدالة       "
'       ويمكنك اضافة اي معيار آخر         "
'        بجانب المعايير الموجودة             "
'          MyArray  في المتغير              "
'      مع مراعاة وجود فراغ بداية
'           او نهاية المعيار
'========================================"
'-----------------------------------------------------------------
Function Kh_Father_Name(ByVal Name As String, Optional kh_First As Boolean) As String
Dim KhString As String, Kh_Mid As String, Kh_Rep  As String
Dim KhMyNo As Integer
    On Error GoTo Err_Kh_Father_Name
    If IsEmpty(Name) Then GoTo Err_Kh_Father_Name
    KhString = Kh_Father_Replace(Trim(Name)) & " "
    KhMyNo = InStr(1, KhString, " ", 1)
    If kh_First Then Kh_Mid = Trim(Mid(KhString, 1, KhMyNo)) Else _
    Kh_Mid = Trim(Mid(KhString, KhMyNo, Len(KhString)))
    Kh_Rep = Replace(Kh_Mid, "^", " ")
    Kh_Father_Name = Kh_Rep
    
    Exit Function

Err_Kh_Father_Name:
     Kh_Father_Name = ""
End Function
Private Function Kh_Father_Replace(ByVal Kh_Sub As String) As String
Dim MyArray, Ar
Dim Sn As String, Re As String
'====================================================
' يمكنك اضافة اي معيار آخر هنا بجانب المعايير الموجودة

MyArray = Array("عبد ", "أبو ", "ابو ", "آل ", " الله" _
    , " الدين", " الإسلام", " الاسلام", " الحق")
'====================================================
Sn = Kh_Sub
For Each Ar In MyArray
    Re = Replace(Ar, " ", "^")
    Sn = Replace(Sn, Ar, Re)
Next
Kh_Father_Replace = Sn
End Function