مختار حسين محمود

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

ظروف الحياة قد تبعدنا لكن لن تنسينا المنتدى الذى تعلمنا منه الكثير والكثير .

النهرده لى طلب من خبراء المعادلات  :

أولا عندى جدول حصص فى شيت Table

1- فى  شيت Classes        مطلوب معادلة بحث عن  جدول الفصل        ( ملحوظة : اسم الفصل متغير فى الورقة بغير خلية اخرى) .

2 - فى  شيت Teachers    مطلوب معادلة بحث عن  جدول المعلم        ( ملحوظة : اسم المعلم متغير فى الورقة بغير خلية اخرى) .

الملحوظة المهمة فى الطلب الثانى :

ان المدرس أحيانا يدرس مادة منفردا  أو احيانا مشتركا مع مدرس أو مدرسين آخرين كما فى حصص المجالات مثلا

مثال  السبت الحصة الاولى    فى فصل .....      عربى        مختار

        السبت الحصة الثانية     فى فصل ......      عربى        مختار

        السبت الحصة الثالثة     فى فصل ......     مجالات    مختار + سيد + محمود

        السبت الحصة الرابعة    فى فصل ......     مجالات    مختار + سيد + محمود

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

ملف التطبيق :

test 1.xlsm

أخى سليم مشكور على الاضافة

أنا لا أقصد من الدالة مجرد الفصل بين الاسماء

ولكن أقصد استخلاص اسم محدد من اسم الشخص 

لو عندى اسم بالشكل ده : عبد الله عبد الرحمن نور الدين عبد الحافظ

 الكود الذى تفضلت به لا يمكنه استخلاص اسم الأب فقط أو الجد فقط أو اللقب فقط

أرجو أن تكون الصورة واضحة

الاخ خليل معذرة  الموضوع متكرر تفضل

Mokhtar Family New UDF.rar

السلام عليكم ورحمة الله وبركاته
بداية نشكر الأستاذ عبدالله باقشير الذى قدم لنا الدالة الشهيرة Kh_Father_Name
لاستخراج اسم الاب كاملا من اسم الشخص  العربى و ذلك بمساعدة الدالة Kh_Father_Replace

ثانيا أقدم لكم الدالة المستحدثة MokhtarFamily  تشبه دالة الاستاذ عبدالله فى العمل والخواص إلا إنها أشمل
نوعا ما حيث تستطيع الدالة أن تقوم باستخراج الآتى
 1- اسم الابن
 2- اسم الاب
3- اسم الاب كاملا
4- اسم الجد
5- اسم الجد كاملا
6- اسم العائلة

الصورة العامة للدالة
( MokhtarFamily (StrgName,NameNum,AcceptSingle

تلاحظ أن الدالة تتكون من 3 بارامتر StrgName   NameNum   AcceptSingle

البارامتر الاول نص اجبارى يحمل اسم الشخص الذى تتعامل معه

البارامتر  الثانى عدد اجبارى من 1 الى 4
  1    لاستخراج اسم الابن
  2    لاستخراج اسم الاب
  3   لاستخراج اسم الجد
  4   لاستخراج اسم العائلة أو اللقب

البارامتر  الثالث اختيارى بين قيمتين هما  False و True
فى كل الأحوال ناتج الدالة يكون اسما منفردا  
باستثناء  True  فى استخراج اسم الأب أو الجد فقط  حيث تأتى باسم الأب أو الجد كاملا   

كود الدالة مع التعليقات

Option Explicit

Public Function MokhtarFamily(ByVal StrgName As String, ByVal NameNum As Integer, Optional AcceptNext As Boolean) As String
' Author  : Mokhtar Hussein
' Release : 5 - 11 - 2016  Assuit Eygypt
' The MokhtarFamily is a new User Defined Function returns son's name or Father's name
' or Grandfather's name or Family's name of Arab person's name bases on a specific number.
' The MokhtarFamily udf takes into consideration the Arab complex names
' The Syntax :
' MokhtarFamily(StrgName,NameNum,AcceptNext)
' The MokhtarFamily function syntax has these named arguments:
' 1 - StrgName : Required String
'     - The person's name which you are useing.
' 2 - NameNum  : Required Integer
'     - 1 to return the son's name.
'     - 2 to return the Father's name
'     - 3 to return the Grandfather's name
'     - 4 to return the Family's Name .
' 3 - AcceptNext : Optional False or True
'     - False to return all names in a Single form
'     - True to return Father's name and Grandfather's name of fourfold Arab person's name ln a full form
'--------------------------------------------------------------------------------------------------------------------------------------
' الاعلان عن المتغيرات
Dim TempName As String, SonName As String, Fname As String, GfName As String, FamilyName As String, Ipos As Integer
Dim Sn As String, OtherNames As String, xName As String, xxName As String, xxxName As String, xxxxName As String, Arr, itm
' أضف هنا المقطع الأول ملحقا بفراغ أوالثانى مسبوقا بفراغ والتى تتكون منها الأسماء المركبة مثل عبد الرحمن أو المعتصم بالله
Arr = Array("أبو ", "ابو ", "عبد ", "آل ", " الله", " الدين", " الإسلام", " الاسلام", " الهدى", " الحق", " النصر", " العهد", " النور", " بالله", " الزهراء", " كلثوم")
' ErrorHandlerفى حالة حدوث خطأ اذهب الى السطر الذى يبدأ بـ
 On Error GoTo ErrorHandler
'   جعل الدالة حساسة لأى تغير فى الخلية التى تعمل عليها
' بمعنى أى تغير فى الخلية يتبعه تغير ناتج الدالة مباشرة
Application.Volatile True
' التعامل مع الاسماء المركبة
' Arr حلقة تكرارية على كل اسم مركب فى المصفوفة
For Each itm In Arr
    ' استبدال الفراغ بين المقطعين بشرطة واعتبارهما اسم واحد
    TempName = Replace(itm, " ", "_")
    ' وضع الشرطة فى كل اسم مركب يوجد باسم الشخص
    ' باستبدال أى اسم مركب به فراغ
    ' باسم مركب به شرطة بين مقطعيه
    StrgName = Replace(StrgName, itm, TempName)
    ' الانتقال الى الاسم التالى
Next itm
' بالخطوة السابقة صار الاسم المركب اسما واحدا
' الخطوة التالية فحص المتغير الذى يحمل اسم الشخص
' هل المتغير فارغ أم أن هذا المتغير به اسم شخص
' اذا كان المتغير الذى يحمل اسم الشخص فارغا
If IsEmpty(StrgName) Then
   'فاذهب الى السطر
   GoTo ErrorHandler
Else   ' وان لم يكن المتغير فارغا يتم
   ' تخزين اسم الشخص فى متغير جديد
   ' مع حذف الفراغات فقط يمين و يسار اسم الشخص
   ' مع بقاء الفراغات الداخلية بين كل اسم واسم
   ' Trim وذلك يتم باستخدام الدالة
     Sn = Trim(StrgName)
End If
' بالخطوة السابقة صار اسم الشخص جاهزا
' لاستخــراج الأسماء منه على التوالى منه
'وجود فراغ أو فراغات فى اسم الشخص معناه
'أن اسم الشخص مكون من اسمين فرعيين أوأكثر
' وعدم وجود الفراغ دليل على أنه اسم واحد

' =====  استخراج الاسم الأول أى اسم الابن =====
' البحث عن موضع الفراغ الأول فى اسم الشخص
' InStr        وهذا يتم باستخدام الدالة
Ipos = InStr(Sn, " ")
' اذا كان الموضع = صفر
If Ipos = 0 Then
   ' فإن اسم الشخص بدون فراغ وهذا يعنى
   '  أنّ اسم الشخص مكون فقط من اسم واحد
   ' وبالتالى المتغير الذى يحمل الاسم الاول
   ' تكون قيمته = اســــــــم الشخص
      xName = Sn
   ' أيضا المتغير الذى يحمل باقى الأسماء
   ' كاسم الأب و الجد و العائلة = لا شىء
   OtherNames = vbNullString
   ' اسم الابن قد يكون مركبا وبداخله شرطة
   ' للتخلص من الشرطة نضع بدلا منها  فراغ
   SonName = Replace(Trim(xName), "_", " ")
Else ' وان لم يكن الموضع = صفر فإن
  ' هذا معناه أن اسم الشخص به فراغ
  ' ومعناه أنه مكون من اسمين أو أكثر
  ' اسم الابن = الحروف التى تقع يسار اسم الشخص
  ' انتهاء بالحرف الذى يسبق  الفراغ  مباشرة
  xName = Left(Sn, Ipos - 1)
  ' أيضا المتغير الذى يحمل باقى الأسماء
  ' يساوى كل الحروف التى  تقع يمين الفراغ مباشرة
  'هذا المتغير نستخرج منه باقى الأسماء على التوالى
  OtherNames = Trim(Right(Sn, Len(Sn) - Ipos))
  ' استبدال الشرطة فى اسم الابن المركب بفراغ
  SonName = Replace(Trim(xName), "_", " ")
End If

' =====  استخراج الاسم الثانى أى اسم الأب =====
'  استخراج الاسم الثانى أو اسم الأب  بنفس الكيفية السابقة
'  لكن من المتغير الذى يحمل الأسماء التى تقع بعد اسم الابن
Ipos = InStr(OtherNames, " ")
If Ipos = 0 Then
   xxName = OtherNames
   OtherNames = vbNullString
   Fname = Replace(Trim(xxName), "_", " ")
Else
   xxName = Left(OtherNames, Ipos - 1)
   OtherNames = Trim(Right(OtherNames, Len(OtherNames) - Ipos))
   Fname = Replace(Trim(xxName), "_", " ")
End If
' =====  استخراج الاسم الثالث أى اسم الجد =====
'  استخراج الاسم الثالث أو اسم الجد  بنفس الكيفية السابقة
'  لكن من المتغير الذى يحمل الأسماء التى تقع بعد اسم الأب
Ipos = InStr(OtherNames, " ")
If Ipos = 0 Then
   xxxName = OtherNames
   OtherNames = vbNullString
   GfName = Replace(Trim(xxxName), "_", " ")
Else
   xxxName = Left(OtherNames, Ipos - 1)
   OtherNames = Trim(Right(OtherNames, Len(OtherNames) - Ipos))
   GfName = Replace(Trim(xxxName), "_", " ")
End If
' =====  استخراج الاسم الرابع أى اسم العائلة =====
'  استخراج الاسم الرابع أو اسم العائلة بنفس الكيفية السابقة
'  لكن  من المتغير الذى يحمل الأسماء التى تقع بعد اسم الجد
Ipos = InStr(OtherNames, " ")
If Ipos = 0 Then
   xxxxName = OtherNames
   OtherNames = vbNullString
   FamilyName = Replace(Trim(xxxxName), "_", " ")
Else
   xxxxName = Left(OtherNames, Ipos - 1)
   OtherNames = Trim(Right(OtherNames, Len(OtherNames) - Ipos))
   FamilyName = Replace(Trim(xxxxName), "_", " ")
End If

' =====  النتائج المختلفة للدالة =====
' اذا كان المتغير رقما ويساوى 1
 If IsNumeric(NameNum) And NameNum = 1 Then
   ' ناتج الدالة = اسم الابن :الخروج من الدالة
    MokhtarFamily = SonName: Exit Function           ' اسم الابن
' أيضا اذا  كان المتغير رقما ويساوى 4
ElseIf IsNumeric(NameNum) And NameNum = 4 Then    ' اسم العائلة أو اللقب
    ' ناتج الدالة = اسم العائلة :الخروج من الدالة
   MokhtarFamily = FamilyName: Exit Function
End If
' اذا كان المتغير لا يساوى True
If AcceptNext <> True Then
' و كان المتغير رقما ويساوى 2
If IsNumeric(NameNum) And NameNum = 2 Then
'ناتج الدالة = اسم الاب فقط :الخروج من الدالة
   MokhtarFamily = Fname: Exit Function
' واذا كان المتغير رقما ويساوى 3
ElseIf IsNumeric(NameNum) And NameNum = 3 Then
' ناتج الدالة = اسم الجد فقط :الخروج من الدالة
   MokhtarFamily = GfName: Exit Function
End If: End If
' اذا كان المتغير لا يساوى False
If AcceptNext <> False Then
' و كان المتغير رقما ويساوى 2
If IsNumeric(NameNum) And NameNum = 2 Then
'ناتج الدالة = اسم الاب كاملا باضافةالجد والعائلة ويفصل بينهم فراغ  :الخروج من الدالة
   MokhtarFamily = Fname & Space(1) & GfName & Space(1) & FamilyName: Exit Function
' واذا كان المتغير رقما ويساوى 3
ElseIf IsNumeric(NameNum) And NameNum = 3 Then
'  ناتج الدالة = اسم الجد كاملا باضافةالعائلة ويفصل بينهما فراغ
   MokhtarFamily = GfName & Space(1) & FamilyName: Exit Function
End If: End If

' اعتبارا ناتج الدالة لا شىء فى حالة حدوث أخطاء
ErrorHandler: MokhtarFamily = vbNullString

End Function

المرفق يوضح   
 كيفية استخدام الدالة مباشرة على الخلايا  و كيفية استدعاء الدالة بالكود

أتمنى أن تكون الدالة مفيدة وتنال اعجابكم

مع خالص تحياتى

السلام عليكم ورحمة الله وبركاته
بداية نشكر الأستاذ عبدالله باقشير الذى قدم لنا الدالة الشهيرة Kh_Father_Name
لاستخراج اسم الاب كاملا من اسم الشخص  العربى و ذلك بمساعدة الدالة Kh_Father_Replace

ثانيا أقدم لكم الدالة المستحدثة MokhtarFamily  تشبه دالة الاستاذ عبدالله فى العمل والخواص إلا إنها أشمل
نوعا ما حيث تستطيع الدالة أن تقوم باستخراج الآتى
 1- اسم الابن
 2- اسم الاب
3- اسم الاب كاملا
4- اسم الجد
5- اسم الجد كاملا
6- اسم العائلة منفردا  

الصورة العامة للدالة
 MokhtarFamily (StrgName,NameNum,AcceptSingle)

تلاحظ أن الدالة تتكون من 3 بارامتر StrgName   NameNum   AcceptSingle

البارامتر الاول نص اجبارى يحمل اسم الشخص الذى تتعامل معه

البارامتر  الثانى عدد اجبارى من 1 الى 4
  1    لاستخراج اسم الابن
  2    لاستخراج اسم الاب
  3   لاستخراج اسم الجد
  4   لاستخراج اسم العائلة أو اللقب

البارامتر  الثالث اختيارى بين قيمتين هما  False و True
فى كل الأحوال ناتج الدالة يكون اسما منفردا  
باستثناء  True  فى استخراج اسم الأب أو الجد فقط  حيث تأتى باسم الأب أو الجد كاملا   

كود الدالة مع التعليقات

Option Explicit

Public Function MokhtarFamily(ByVal StrgName As String, ByVal NameNum As Integer, Optional AcceptNext As Boolean) As String
' Author  : Mokhtar Hussein
' Release : 5 - 11 - 2016  Assuit Eygypt
' The MokhtarFamily is a new User Defined Function returns son's name or Father's name
' or Grandfather's name or Family's name of Arab person's name bases on a specific number.
' The MokhtarFamily udf takes into consideration the Arab complex names
' The Syntax :
' MokhtarFamily(StrgName,NameNum,AcceptNext)
' The MokhtarFamily function syntax has these named arguments:
' 1 - StrgName : Required String
'     - The person's name which you are useing.
' 2 - NameNum  : Required Integer
'     - 1 to return the son's name.
'     - 2 to return the Father's name
'     - 3 to return the Grandfather's name
'     - 4 to return the Family's Name .
' 3 - AcceptNext : Optional False or True
'     - False to return all names in a Single form
'     - True to return Father's name and Grandfather's name of fourfold Arab person's name ln a full form
'--------------------------------------------------------------------------------------------------------------------------------------
' الاعلان عن المتغيرات
Dim TempName As String, SonName As String, Fname As String, GfName As String, FamilyName As String, Ipos As Integer
Dim Sn As String, OtherNames As String, xName As String, xxName As String, xxxName As String, xxxxName As String, Arr, itm
' أضف هنا المقطع الأول ملحقا بفراغ أوالثانى مسبوقا بفراغ والتى تتكون منها الأسماء المركبة مثل عبد الرحمن أو المعتصم بالله
Arr = Array("أبو ", "ابو ", "عبد ", "آل ", " الله", " الدين", " الإسلام", " الاسلام", " الهدى", " الحق", " النصر", " العهد", " النور", " بالله", " الزهراء", " كلثوم")
' ErrorHandlerفى حالة حدوث خطأ اذهب الى السطر الذى يبدأ بـ
 On Error GoTo ErrorHandler
'   جعل الدالة حساسة لأى تغير فى الخلية التى تعمل عليها
' بمعنى أى تغير فى الخلية يتبعه تغير ناتج الدالة مباشرة
Application.Volatile True
' التعامل مع الاسماء المركبة
' Arr حلقة تكرارية على كل اسم مركب فى المصفوفة
For Each itm In Arr
    ' استبدال الفراغ بين المقطعين بشرطة واعتبارهما اسم واحد
    TempName = Replace(itm, " ", "_")
    ' وضع الشرطة فى كل اسم مركب يوجد باسم الشخص
    ' باستبدال أى اسم مركب به فراغ
    ' باسم مركب به شرطة بين مقطعيه
    StrgName = Replace(StrgName, itm, TempName)
    ' الانتقال الى الاسم التالى
Next itm
' بالخطوة السابقة صار الاسم المركب اسما واحدا
' الخطوة التالية فحص المتغير الذى يحمل اسم الشخص
' هل المتغير فارغ أم أن هذا المتغير به اسم شخص
' اذا كان المتغير الذى يحمل اسم الشخص فارغا
If IsEmpty(StrgName) Then
   'فاذهب الى السطر
   GoTo ErrorHandler
Else   ' وان لم يكن المتغير فارغا يتم
   ' تخزين اسم الشخص فى متغير جديد
   ' مع حذف الفراغات فقط يمين و يسار اسم الشخص
   ' مع بقاء الفراغات الداخلية بين كل اسم واسم
   ' Trim وذلك يتم باستخدام الدالة
     Sn = Trim(StrgName)
End If
' بالخطوة السابقة صار اسم الشخص جاهزا
' لاستخــراج الأسماء منه على التوالى منه
'وجود فراغ أو فراغات فى اسم الشخص معناه
'أن اسم الشخص مكون من اسمين فرعيين أوأكثر
' وعدم وجود الفراغ دليل على أنه اسم واحد

' =====  استخراج الاسم الأول أى اسم الابن =====
' البحث عن موضع الفراغ الأول فى اسم الشخص
' InStr        وهذا يتم باستخدام الدالة
Ipos = InStr(Sn, " ")
' اذا كان الموضع = صفر
If Ipos = 0 Then
   ' فإن اسم الشخص بدون فراغ وهذا يعنى
   '  أنّ اسم الشخص مكون فقط من اسم واحد
   ' وبالتالى المتغير الذى يحمل الاسم الاول
   ' تكون قيمته = اســــــــم الشخص
      xName = Sn
   ' أيضا المتغير الذى يحمل باقى الأسماء
   ' كاسم الأب و الجد و العائلة = لا شىء
   OtherNames = vbNullString
   ' اسم الابن قد يكون مركبا وبداخله شرطة
   ' للتخلص من الشرطة نضع بدلا منها  فراغ
   SonName = Replace(Trim(xName), "_", " ")
Else ' وان لم يكن الموضع = صفر فإن
  ' هذا معناه أن اسم الشخص به فراغ
  ' ومعناه أنه مكون من اسمين أو أكثر
  ' اسم الابن = الحروف التى تقع يسار اسم الشخص
  ' انتهاء بالحرف الذى يسبق  الفراغ  مباشرة
  xName = Left(Sn, Ipos - 1)
  ' أيضا المتغير الذى يحمل باقى الأسماء
  ' يساوى كل الحروف التى  تقع يمين الفراغ مباشرة
  'هذا المتغير نستخرج منه باقى الأسماء على التوالى
  OtherNames = Trim(Right(Sn, Len(Sn) - Ipos))
  ' استبدال الشرطة فى اسم الابن المركب بفراغ
  SonName = Replace(Trim(xName), "_", " ")
End If

' =====  استخراج الاسم الثانى أى اسم الأب =====
'  استخراج الاسم الثانى أو اسم الأب  بنفس الكيفية السابقة
'  لكن من المتغير الذى يحمل الأسماء التى تقع بعد اسم الابن
Ipos = InStr(OtherNames, " ")
If Ipos = 0 Then
   xxName = OtherNames
   OtherNames = vbNullString
   Fname = Replace(Trim(xxName), "_", " ")
Else
   xxName = Left(OtherNames, Ipos - 1)
   OtherNames = Trim(Right(OtherNames, Len(OtherNames) - Ipos))
   Fname = Replace(Trim(xxName), "_", " ")
End If
' =====  استخراج الاسم الثالث أى اسم الجد =====
'  استخراج الاسم الثالث أو اسم الجد  بنفس الكيفية السابقة
'  لكن من المتغير الذى يحمل الأسماء التى تقع بعد اسم الأب
Ipos = InStr(OtherNames, " ")
If Ipos = 0 Then
   xxxName = OtherNames
   OtherNames = vbNullString
   GfName = Replace(Trim(xxxName), "_", " ")
Else
   xxxName = Left(OtherNames, Ipos - 1)
   OtherNames = Trim(Right(OtherNames, Len(OtherNames) - Ipos))
   GfName = Replace(Trim(xxxName), "_", " ")
End If
' =====  استخراج الاسم الرابع أى اسم العائلة =====
'  استخراج الاسم الرابع أو اسم العائلة بنفس الكيفية السابقة
'  لكن  من المتغير الذى يحمل الأسماء التى تقع بعد اسم الجد
Ipos = InStr(OtherNames, " ")
If Ipos = 0 Then
   xxxxName = OtherNames
   OtherNames = vbNullString
   FamilyName = Replace(Trim(xxxxName), "_", " ")
Else
   xxxxName = Left(OtherNames, Ipos - 1)
   OtherNames = Trim(Right(OtherNames, Len(OtherNames) - Ipos))
   FamilyName = Replace(Trim(xxxxName), "_", " ")
End If

' =====  النتائج المختلفة للدالة =====
' اذا كان المتغير رقما ويساوى 1
 If IsNumeric(NameNum) And NameNum = 1 Then
   ' ناتج الدالة = اسم الابن :الخروج من الدالة
    MokhtarFamily = SonName: Exit Function           ' اسم الابن
' أيضا اذا  كان المتغير رقما ويساوى 4
ElseIf IsNumeric(NameNum) And NameNum = 4 Then    ' اسم العائلة أو اللقب
    ' ناتج الدالة = اسم العائلة :الخروج من الدالة
   MokhtarFamily = FamilyName: Exit Function
End If
' اذا كان المتغير لا يساوى True
If AcceptNext <> True Then
' و كان المتغير رقما ويساوى 2
If IsNumeric(NameNum) And NameNum = 2 Then
'ناتج الدالة = اسم الاب فقط :الخروج من الدالة
   MokhtarFamily = Fname: Exit Function
' واذا كان المتغير رقما ويساوى 3
ElseIf IsNumeric(NameNum) And NameNum = 3 Then
' ناتج الدالة = اسم الجد فقط :الخروج من الدالة
   MokhtarFamily = GfName: Exit Function
End If: End If
' اذا كان المتغير لا يساوى False
If AcceptNext <> False Then
' و كان المتغير رقما ويساوى 2
If IsNumeric(NameNum) And NameNum = 2 Then
'ناتج الدالة = اسم الاب كاملا باضافةالجد والعائلة ويفصل بينهم فراغ  :الخروج من الدالة
   MokhtarFamily = Fname & Space(1) & GfName & Space(1) & FamilyName: Exit Function
' واذا كان المتغير رقما ويساوى 3
ElseIf IsNumeric(NameNum) And NameNum = 3 Then
'  ناتج الدالة = اسم الجد كاملا باضافةالعائلة ويفصل بينهما فراغ
   MokhtarFamily = GfName & Space(1) & FamilyName: Exit Function
End If: End If

' اعتبارا ناتج الدالة لا شىء فى حالة حدوث أخطاء
ErrorHandler: MokhtarFamily = vbNullString

End Function

المرفق يوضح   
 كيفية استخدام الدالة مباشرة على الخلايا  و كيفية استدعاء الدالة بالكود

أتمنى أن تكون الدالة مفيدة وتنال اعجابكم

مع خالص تحياتى

Mokhtar Family New UDF.rar

السلام عليكم ورحمة الله وبركاته

جزاك الله خيرا أستاذى الكريم و زادك من علمه تحياتى

   بارك الله فيك أخى الزيارى وفى وقتك وجهدك  موضوع رائع ومفيد لكل محبى الفيجوال بيزك

تحياتى

1 ساعه مضت, عاطف عبد العليم محمد said:

السلام عليكم ورحمة الله وبركاته

وفقك الله أخ ياسر العربي  وجزاك الله خيرا 

كود روعة يا ابو العربى  خاصة مع استخدام المصفوفات   تحياتى

بقالى نصف ساعة على الصفحة عشان اعمل مشاركة النت سلحفاة

اضافة الى كلام  أستاذى الفاضل

جرب الكود التالى على ملفك  الكود يؤكد أن المسافة الفارغة لها قيمة عند اكسل

Sub Test2()
    Dim Cel As Range
    For Each Cel In Range("A2:A29")
    Cel.Offset(, 3).Value = Len(Cel) & " " & " حرف بالمسافات"
    Cel.Offset(, 4).Value = Len(Replace(Cel, " ", "")) & " " & "حرف بدون المسافات"
    Next Cel
    Cells.ShrinkToFit = True
End Sub

جزاك الله خيرا أستاذى الفاضل

الدالة LEN تحسب أيضا المسافات بين النصوص

وأعتقد حسب فهمى لطلب الأخ وائل أنه يريد فصل النصوص التى تبلغ كحد أقصى 255  بدون مسافات  تحياتى

أشكرك أخى و أستاذى الغالى

جارى التحميل  ولا شك فى النتيجة قبل التجربة 

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

split string from number stored as text Mokhtar 2.rar

split string from number stored as text Mokhtar 2.rar

يا سلام   من غير ما تقول أخى و أستاذى

Option Explicit

Sub GetText()
' Author  : Mokhtar
' Release :  8 - 10 - 2016
' split Text from  numbers stored as text numbers
'--------------------------------------------------
Dim C     As Range
Dim FC    As Range
Dim Rng      As Range
Dim SRng     As Range
Dim I        As Long
Dim N        As Long
Dim S        As String
Dim Arr      As Variant
Dim StrStart As String

Application.ScreenUpdating = False
Range("D2").Resize(4).ClearContents
For I = 2 To 5
     S = Range("B" & I)
     Arr = Split(S, " ")
     Cells(I, 6).Resize(1, UBound(Arr) + 1) = Arr
Next I
Set SRng = Cells(2, 6).CurrentRegion
For Each C In SRng.Cells
        C.Value = WorksheetFunction.Text(C, 0)
        If IsNumeric(C.Value) = True Then C.ClearContents
Next C
For N = 2 To 5
     Set Rng = Range("F" & N, "Z" & N)
     Set FC = Range("D" & N)
     For Each C In Rng
        StrStart = C
        C.ClearContents
        FC = Trim(Replace(FC, FC, "") & " " & FC & " " & StrStart)
     Next C
Next N
Application.ScreenUpdating = True
End Sub

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

split string from number stored as text Mokhtar.rar

أشكرك أستاذى الغالى ياسر

أعتقد أن الاخ محمد يريد فصل الأرقام فقط  من النص  ولا أنا فاهم غلط

بعد اذن أستاذى ياسر

تفضل أستاذ محمد الكود :

Option Explicit
Sub GetNumber()
' Author  : Mokhtar
' Release :  8 - 10 - 2016
' split and convert numbers stored as text numbers
'--------------------------------------------------
Dim C     As Range
Dim Rng   As Range
Dim I     As Long
Dim N     As Long
Dim S     As String
Dim Arr   As Variant
Application.ScreenUpdating = False
Range("C2").Resize(4).ClearContents
For I = 2 To 5
     S = Range("B" & I)
     Arr = Split(S, " ")
     Cells(I, 4).Resize(1, UBound(Arr) + 1) = Arr
Next I
Set Rng = Cells(2, 4).CurrentRegion
For Each C In Rng.Cells
    C.Value = WorksheetFunction.Text(C, 0)
    If IsNumeric(C.Value) = True Then
         If C.Value > 0 Then
                N = N + 1
                ReDim Preserve Arr(1 To N)
             Arr(N) = CDbl(C.Value)
         End If
     End If
Next C
Rng.ClearContents
Range("C2").Resize(UBound(Arr, 1), 1) = Application.Transpose(Arr)
Erase Arr
Set C = Nothing
Set Rng = Nothing
Application.ScreenUpdating = True
End Sub

تحياتى

و يشرفنى أن أكون أحد تلاميذك  لعلمك  وتواضعك    وقوة  الارادة لديك    تحياتى

ما شاء الله عليك أستاذى سلمت يمينك  ابا البراء

أنا أغبطك  بجد     (  العين عليها حارس لربما حد يفتكرها حاجة تانى )     

10 ساعات مضت, أحمد الفلاحجى said:

جزاك الله كل خير يا ابو البراء وزادك الله من فضله وعلمه

ربنا يبارك فى عمرك ويحميك ابا البراء  تقبل خالص تحياتى وتقديرى

تحياتى لك أخى و حبيبى ياسر

الحل المقدم من حضرتك أكثر من رائع 

تم اضافة جمع الاصناف فى كل صف  

استفسار أستاذى الفاضل حاولت استخدام المصفوفات  فـ     كيف استخدم  المصفوفات فى حاجة زى كده  ؟
 

استخراج الحقول ذات القيم بالترتيب وتجاهل الخلايا الفارغة.rar

أشكرك على المتابعة وضبط المعادلات

كنت فى عجلة ( عجلة أى سرعة مش بسكلته ) من امرى

أنا مثلك تماما أفضل الاكواد والتعامل معها  على المعادلات وخصوصا الصفيف 

لكن فيه ناس بتحب المعادلات  نعمل ايه  ؟!    غير اننا نحاول تقديم كل الحلول  ( وجهة نظر )        تحياتى

الاخ زياد السلام عليكم

رجاء ارفع ملفا لاخوانك للعمل عليه

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

وممكن يكون فى حصة تربية دينية مع الاستاذ مينا   محمد يدرس دين اسلامى ومينا دين مسيحى 

أخى جلال الجمال نشكرك على المرور العطر على الموضوع كما أشكرك على نشاط فى المنتدى والموضوعات القيمة  تحياتى

بارك الله فيك  أخى وأستاذى ياسر

وائراء للموضوع  يمكن الحصول على نفس النتائج بمعادلة و udf

تحياتى

List The Unique And Concatenate Corresponding Values udf.rar

أستاذى ياسر خليل  شرفنى مروركم و أنت الأروع دائما

أخى قلم الاكسل أشكرك بس بلاش صواعق دى حسيت انى زى راجون

أستاذى سليم شرفنى مروركم  وأشكرك على المعادلة بالفعل أنا ظلمته عن جهل بالمعادلة  لكن رب ضارة نافعة

أشكرك أستاذى أبوعيد على المرور والرابطين  تحياتى للجميع

السلام عليكم و رحمة الله وبركاته

مقدمة لفهم الفكرة

اليومين دوول بعمل جدول حصص لمدرستى

و شكل توزيع المدرسين فى الجدول بيكون بالشكل ده  : 

فى الحصة المنفردة بيكون بالشكل ده  :  محمد  فى الخلية B2  مثلا

فى الحصة المشتركة بيكون بالشكل ده  :  محمد  +  محمود   فى الخلية B3  مثلا

وعشان أحسب عدد حصص محمد فى الخليتين بالدالة COUNTIF  كان الناتج  1 فقط

ليه الناتج كان 1 مش 2

شفتوا شفتوا  حتى الاكسل اللى أكل دماغنا جاى على المدرس و حسب له 1 مش 2

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

طبعا أنا مدرس زى الأستاذ محمد  فوجب عليا أن أنصره على الاكسل الظالم أحيانا وأرجع له حقه

فكانت  هذه الدالة المستحدثة عشان تدى الأستاذ محمد حقه وتحسب له كام حصة اشتغل فيها هذا المعلم

****************

اسم الدالة : MokhtarCountif   تشبه الدالة COUNTIF  فى العمل مع الفارق الفارق أن دالتى تبحث عن النص حتى ان كان النص كلمة من مجموعة كلمات بالخلية

تتكون الدالة من عدد  2 باراميتر :     MyVal  نوعه String   و AddressRange  نوعه Range      والناتج  نوعه  Long

Option Explicit
Function MokhtarCountif(MyVal As String, AddressRange As Range) As Long
' Author  : Mokhtar
' Release :  2 - 10 - 2016
' The MokhtarCountif function counts the number of a single criterion within a cell or range Of cells
' Name          Required/Optional   Data Type   Description
' MyVal         Required            String      The criteria in the form of a number, expression, or text.
' AddressRange  Required            Range       The cell or range of cells which you want to count within.
' Return Value :  Long
'----------------------------------------------------------------------------------------------------
Dim C As Range, Total As Long, Arr() As String, j As Integer
Application.Volatile True
For Each C In AddressRange.Cells
    Arr = Split(C, " ")
      For j = LBound(Arr) To UBound(Arr)
          If Arr(j) = MyVal Then
             On Error Resume Next
               Total = Total + 1
             On Error GoTo 0
           End If
        Next j
    Next C
MokhtarCountif = Total
End Function

أتمنى أن تنال الدالة اعجابكم و  منتظر ملاحظاتكم

مع تحياتى

MokhtarCountif udf.rar

العفو أستاذى الغالى 

كنت و ما زلت وسأظل أتعلم منك و تواضعك الشديد هذا يزيدنى شرفا وفخرا بأن أقول أنك أستاذى فى vba 

تحياتى

نعم أستاذ خالد

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

وزى ما أستاذنا الغالى  قال يمكن اضافة سطر لتنشيط ورقة بعينها   مع خالص تحياتى