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

احبابنا فى المنتدى الغالى السلام عليكم ورحمة الله وبركاته ظروف الحياة قد تبعدنا لكن لن تنسينا المنتدى الذى تعلمنا منه الكثير والكثير . النهرده لى طلب من خبراء المعادلات : أولا عندى جدول حصص فى شيت 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

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

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

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

بقالى نصف ساعة على الصفحة عشان اعمل مشاركة النت سلحفاة اضافة الى كلام أستاذى الفاضل جرب الكود التالى على ملفك الكود يؤكد أن المسافة الفارغة لها قيمة عند اكسل 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 تحياتى

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

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