اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

دالة استخراج اسم ولي الامر كاملا او الاسم الاول مفردا


الردود الموصى بها

السلام عليكم
 

دالة استخراج اسم ولي الامر كاملا او الاسم الاول مفردا



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

خبور خير

استخراج اسم ولي الامر كاملا او الاسم الاول مفردا.rar

  • Like 2
  • Thanks 1
رابط هذا التعليق
شارك

بوركت يا عالمنا الكبير

مش عارف من غيرك كنا وصلنا لفين ؟أكيد كنا لسه ورا قوي

جزاك الله عنا كل خير

والله إنس لأستفيد من إبداعاتك المستمرة أنا وغيري فسر على الدرب أخي الغالي

رابط هذا التعليق
شارك

  • 2 weeks later...
  • 9 months later...

الأخوة الأعزاء

الحقيقة الواحد يدخل على منتدى أكسيل وهو مرعوب من العمالقة اللي فيه

اسمحوا لي اخواني بهذا التعديل البسيط حيث قمت بعمل (توليفة) بين دالة تم إعدادها بأكسس بدالة الأستاذ خبور

بحيث يصبح بالإمكان إستخراج أي جزء مطلوب من الإسم

أرجو أن أكون موفقاً في هذه (التوليفة)

تحياتي,,,

تجزئة الأسماء.rar

  • Like 2
رابط هذا التعليق
شارك

الأخوة الأعزاء

الحقيقة الواحد يدخل على منتدى أكسيل وهو مرعوب من العمالقة اللي فيه

أرجو أن أكون موفقاً في هذه (التوليفة)

مرحباً بك يا ابا ناصر (عملاق من عمالقة الاكسس والاكسل معاً)ويتشرف قسم الاكسل باطلالتك البهية عليه

والتوليفة (المعادلة) روووووعة جداً يا ابا ناصر سلمت يمينك

ابواحمد

رابط هذا التعليق
شارك

مشكور اخي ابو احمد على الكلام الطيب

الموضوع ليس فيه اي عملقة ولا شيئ ولكن هذا مايثبت ان اي دوال تصمم في اكسس يمكن تنفيذها في اكسل وحتى وورد (والعكس صحيح) فجميعها تعمل في بيئة واحدة هي بيئة(VBA)ولكن الصعوبة التي واجهتني كانت انه يتم اخذ الاستثناءات الخاصة بالأسماء كـ(عبد , الله , الدين , ....الخ) من جدول في قاعدة البيانات ولم أكن أعرف طريقة التنفيذ في اكسل

فقد كان أفكر ان أجعلها في ورقة مستقلة بحيث يتم أخذها من هذه الورقة وبصراحة فأنا أجهل كيفية التعامل مع اوراق العمل والخلايا في اكسل

ولكن الأستاذ خبور (وهو العملاق الحقيقي) قد تجاوزها بواسطة إستخدامه المصفوفة ومن هنا تم عمل التوليفة

في الأخير لدي استفسار هل هناك إمكانية لتنفيذ هذه الطريقة (ان يتم وضع الإستثناءات في ورقة مستقلة) لمنح حرية اكبر للمستخدم...؟

تحياتي,,,

رابط هذا التعليق
شارك

  • 4 weeks later...
  • 1 year later...
زائر
هذا الموضوع مغلق.
×
×
  • اضف...

Important Information