أكاديمية الصقر للتدريب

لوحة التميز الأسبوعي
العضو المتميز المشرف المتميز المراقب المتميز المدير المتميز الموضوع المتميز القسم المتميز
العضو المتميز المشرف المتميز المراقب المتميز المدير المتميز الموضوع المتميز القسم المتميز
khaled alborene Eslam Abdullah-- لا تميز خلال هذه الفترة YasserKhalil تثبيت الكود علي خليه معينه اكسيل اسئله واجابات


اعلان هنا
ألعاب فلاش أون لاين
أعلن هنا
أعلن هنا
صفحتنا على الفيس بوك
أعلن هنا



أهلا وسهلا بك زائرنا الكريم في أكاديمية الصقر للتدريب، لكي تتمكن من المشاركة ومشاهدة جميع أقسام المنتدى وكافة الميزات ، يجب عليك إنشاء حساب جديد بالتسجيل بالضغط هنا أو تسجيل الدخول اضغط هنا إذا كنت عضواً .





تجزئة الاسماء المركبة وفصلها عن الاسماء العادية

هناك الكثير من الأكواد حول هذا الموضوع لكن الكود في هذا الملف يستطيع ان يفصل الاسماء المركبة حتى الاسم الرابع و أكثر مع ..



20-07-2019 09:40 مساء
salim
menu_open
خبير معتمد
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 22-08-2017
رقم العضوية : 43
المشاركات : 388
الجنس : ذكر
تاريخ الميلاد : 1-5-1989
الدعوات : 1
يتابعهم : 13
يتابعونه : 16
قوة السمعة : 3165
الاعجاب : 187
 offline 

هناك الكثير من الأكواد  حول هذا الموضوع

لكن الكود في هذا الملف يستطيع ان يفصل الاسماء المركبة حتى الاسم الرابع و أكثر مع اضافة تنسيقات تلوينية للنتائج

و القدرة على اضافة بعض الأسماء الأولى للاسم المركب (عبد ,  أبو  ,  سيف  ,   جمال  الخ....)

Option Explicit

Sub New_Split_Name()
Application.ScreenUpdating = False
Dim my_st$, st1, st2
Dim last_col%
Dim my_name, i%, k%, Col%, int_col%
Dim Lr%: Lr = Cells(Rows.Count, 1).End(3).Row
Dim mon_range As Range
Dim fin_rg As Range
Range("b2").Resize(Lr - 1, 10).Clear
Dim arr: arr = _
Array("سيف", "عبد", "أبو", "ابو", "عز", "صدر", "نور")
'++++++++++++++++++++++++++++++++++++++
Rem     Array تستطيع ان تضيف اي بداية اسم مركب داخل هذا الــ
'+++++++++++++++++++++++++++++++++++++
 For i = 2 To Lr
 If Range("a" & i) = vbNullString Then GoTo Next_i
  my_st = Trim(Range("a" & i))
  my_name = Split(Trim(my_st))
  Range("b" & i).Resize(1, UBound(my_name) + 1) = my_name
Next_i:
  Next
  '==============================
 For i = 2 To Lr
   last_col = Cells(i, Columns.Count).End(1).Column
   Set mon_range = Range(Cells(i, 2), Cells(i, last_col))
   For k = 1 To last_col - 1
    If Not (IsError(Application.match(mon_range.Cells(k), arr, 0))) Then
        st1 = mon_range.Cells(k): st2 = mon_range.Cells(k + 1)
        mon_range.Cells(k).Delete Shift:=xlToLeft
        mon_range.Cells(k) = st1 & " " & st2
    End If
   Next
 Next

   Set fin_rg = Range("a1").CurrentRegion
   Lr = fin_rg.Rows.Count
   Col = fin_rg.Columns.Count
  With fin_rg.Offset(1).Resize(Lr - 1, Col - 1).Offset(, 1)
   .Borders.LineStyle = 1: .Font.Bold = True
   .InsertIndent 1: Columns.AutoFit
   .SpecialCells(2).Interior.ColorIndex = 35
 End With
 Set mon_range = Nothing
 Set fin_rg = Nothing
 Application.ScreenUpdating = True
  '===============================
End Sub

 
 
  sep_complex_names_New.rar   تحميل rar مرات التحميل :(8)
الحجم :(21.864) KB


أثارت هذه المشاركة إعجاب: YasserKhalil، ali mohamed ali، الصقر، abdulwahed catran،





20-07-2019 10:31 مساء
مشاهدة مشاركة منفردة [1]
YasserKhalil
menu_open عضوية موثقة
مراقب عام
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 6650
الجنس : ذكر
تاريخ الميلاد : 1-10-1978
الدعوات : 19
يتابعهم : 0
يتابعونه : 407
قوة السمعة : 18512
الاعجاب : 740
 offline 
look/images/icons/i1.gif تجزئة الاسماء المركبة وفصلها عن الاسماء العادية
الله عليك أخي الحبيب سليم
بارك الله فيك وجزاك الله خير الجزاء

وحشتنا أعمالك يا جدو .. smile

أثارت هذه المشاركة إعجاب: salim،




20-07-2019 10:35 مساء
مشاهدة مشاركة منفردة [2]
YasserKhalil
menu_open عضوية موثقة
مراقب عام
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 6650
الجنس : ذكر
تاريخ الميلاد : 1-10-1978
الدعوات : 19
يتابعهم : 0
يتابعونه : 407
قوة السمعة : 18512
الاعجاب : 740
 offline 
look/images/icons/i1.gif تجزئة الاسماء المركبة وفصلها عن الاسماء العادية
لإثراء الموضوع هذه دالة معرفة من ورائع الأخ الحبيب اسلام عبد الله
لمشاهدة الروابط يلزمك التسجيل في أكاديمية الصقر للتدريب

أثارت هذه المشاركة إعجاب: Eslam Abdullah،




20-07-2019 10:43 مساء
مشاهدة مشاركة منفردة [3]
ali mohamed ali
menu_open
مشرف على منتدى الاكسيل
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 20-11-2017
رقم العضوية : 1757
المشاركات : 1103
الدولة : مصر
الجنس : ذكر
يتابعهم : 0
يتابعونه : 51
قوة السمعة : 4704
الاعجاب : 333
 offline 
look/images/icons/i1.gif تجزئة الاسماء المركبة وفصلها عن الاسماء العادية
أحسنت استاذ بارك الله فيك وزادك الله من فضله

أثارت هذه المشاركة إعجاب: Eslam Abdullah،


توقيع :ali mohamed ali
{ وَقُل رَّبِّ زِدْنِي عِلْمًا }
[ كن على يقين من اعمالنا نخطئ ومن اخطائنا نتعلم ولذلك لا شي مستحيل ]
ساهم دائماً فى حل أى مشكلة او أستفسار لديك مع إضافة رد بشكره
أو دعوة لمن قدم اليك المساعدة,فالجميع هنا يعمل على مساعدة
 الاخرين لوجه الله وان تحتسب له اجر عند الله


20-07-2019 11:27 مساء
مشاهدة مشاركة منفردة [4]
salim
menu_open
خبير معتمد
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 22-08-2017
رقم العضوية : 43
المشاركات : 388
الجنس : ذكر
تاريخ الميلاد : 1-5-1989
الدعوات : 1
يتابعهم : 13
يتابعونه : 16
قوة السمعة : 3165
الاعجاب : 187
 offline 
look/images/icons/i1.gif تجزئة الاسماء المركبة وفصلها عن الاسماء العادية
لاحظت انه اذا تكرر الاسم الاول للاسم المكرر اكثر من مرة  تحدث مشاكل قي تطبيق الكود
مثلاً 
ابراهيم محمد سيف النصر سيف الاسلام السيد 
لذلك قمت بتعديل الكود كما يلي

Option Explicit
Sub split_names()
Application.ScreenUpdating = False
Dim my_st$, st1, st2
Dim last_col%
Dim my_name, i%, k%, Col%, int_col%
Dim Lr%: Lr = Cells(Rows.Count, 1).End(3).Row
Dim mon_range As Range
Dim fin_rg As Range
Range("b2").Resize(Lr - 1, 10).Clear
Dim arr: arr = _
Array("سيف", "عبد", "أبو", "ابو", "عز", "صدر", "نور")
'++++++++++++++++++++++++++++++++++++++
Rem     Array تستطيع ان تضيف اي بداية اسم مركب داخل هذا الــ
'+++++++++++++++++++++++++++++++++++++
 For i = 2 To Lr
 If Range("a" & i) = vbNullString Then GoTo Next_i
  my_st = Trim(Range("a" & i))
  my_name = Split(Trim(my_st))
  Range("b" & i).Resize(1, UBound(my_name) + 1) = my_name
Next_i:
  Next
  '==============================
 For i = 2 To Lr
   last_col = Cells(i, Columns.Count).End(1).Column
   Set mon_range = Range(Cells(i, 2), Cells(i, last_col))
   For k = 1 To last_col - 1
    If Not (IsError(Application.Match(mon_range.Cells(k), arr, 0))) Then
        st1 = mon_range.Cells(k): st2 = mon_range.Cells(k + 1)
        mon_range.Cells(k).Delete Shift:=xlToLeft
        mon_range.Cells(k) = st1 & " " & st2
    End If
   Next
 Next

   Set fin_rg = Range("a1").CurrentRegion
   Lr = fin_rg.Rows.Count
   Col = fin_rg.Columns.Count
  With fin_rg.Offset(1).Resize(Lr - 1, Col - 1).Offset(, 1)
   .Borders.LineStyle = 1: .Font.Bold = True
   .InsertIndent 1: Columns.AutoFit
   .SpecialCells(2).Interior.ColorIndex = 35
 End With
 Set mon_range = Nothing
 Set fin_rg = Nothing
 Application.ScreenUpdating = True
  '===============================
End Sub


الملف الجديد مرفق

تم تحديث الملف في المشاركة الأولى بتاريخ 21/7/2019
 

أثارت هذه المشاركة إعجاب: محمود ابو الدهب، YasserKhalil، ali mohamed ali،




21-07-2019 06:13 صباحا
مشاهدة مشاركة منفردة [5]
YasserKhalil
menu_open عضوية موثقة
مراقب عام
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 6650
الجنس : ذكر
تاريخ الميلاد : 1-10-1978
الدعوات : 19
يتابعهم : 0
يتابعونه : 407
قوة السمعة : 18512
الاعجاب : 740
 offline 
look/images/icons/i1.gif تجزئة الاسماء المركبة وفصلها عن الاسماء العادية
أخي وحبيبي سليم
يفضل دائماً في الموضوعات التي تقدم أن يوضع آخر تحديث في الموضوع مع وضع ملاحظة بتاريخ آخر تحديث لكي لا يتوه الأعضاء
بمعنى أن يتم تعديل المشاركة الأولى ووضع الملف الأخير بعد معالجة الأخطء إن وجدت أو بعد إضافة إضافات جديدة .. ثم الرد في الموضوع بأنه تم تحديث الموضوع بتاريخ كذا كنوع من التوثيق
بارك الله فيك وجزاك الله خيراً

أثارت هذه المشاركة إعجاب: salim،




21-07-2019 06:50 صباحا
مشاهدة مشاركة منفردة [6]
الصقر
menu_open عضوية موثقة
مدير المنتدى
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 2
المشاركات : 1690
الجنس : ذكر
الدعوات : 15
يتابعهم : 0
يتابعونه : 566
قوة السمعة : 17430
الاعجاب : 266
موقعي : زيارة موقعي
 offline 
look/images/icons/i1.gif تجزئة الاسماء المركبة وفصلها عن الاسماء العادية

جزاكم الله خيرا استاذ سليم
123



أثارت هذه المشاركة إعجاب: YasserKhalil،


توقيع :الصقر

اخى العضو الكريم
اذا كنت ترى ان المنتدى مفيد لك
فكن سفيرا لنا بدعوة الاخرين للانضمام معنا
فالدال على الخير كفاعله



21-07-2019 06:57 صباحا
مشاهدة مشاركة منفردة [7]
salim
menu_open
خبير معتمد
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 22-08-2017
رقم العضوية : 43
المشاركات : 388
الجنس : ذكر
تاريخ الميلاد : 1-5-1989
الدعوات : 1
يتابعهم : 13
يتابعونه : 16
قوة السمعة : 3165
الاعجاب : 187
 offline 
look/images/icons/i1.gif تجزئة الاسماء المركبة وفصلها عن الاسماء العادية
المشاركة الأصلية كتبت بواسطة: YasserKhalil
أخي وحبيبي سليم
يفضل دائماً في الموضوعات التي تقدم أن يوضع آخر تحديث في الموضوع مع وضع ملاحظة بتاريخ آخر تحديث لكي لا يتوه الأعضاء
بمعنى أن يتم تعديل المشاركة الأولى ووضع الملف الأخير بعد معالجة الأخطء إن وجدت أو بعد إضافة إضافات جديدة .. ثم الرد في الموضوع بأنه تم تحديث الموضوع بتاريخ كذا كنوع من التوثيق
بارك الله فيك وجزاك الله خيراً

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





21-07-2019 07:05 صباحا
مشاهدة مشاركة منفردة [8]
YasserKhalil
menu_open عضوية موثقة
مراقب عام
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 6650
الجنس : ذكر
تاريخ الميلاد : 1-10-1978
الدعوات : 19
يتابعهم : 0
يتابعونه : 407
قوة السمعة : 18512
الاعجاب : 740
 offline 
look/images/icons/i1.gif تجزئة الاسماء المركبة وفصلها عن الاسماء العادية
ولا يهمك يا جدو .. تم تحميل آخر تحديث للملف في المشاركة الأصلية وحذفها من المشاركة الفرعية لكي لا يتوه الأعضاء ..
جزاك الله خير الجزاء





21-07-2019 08:35 صباحا
مشاهدة مشاركة منفردة [9]
salim
menu_open
خبير معتمد
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 22-08-2017
رقم العضوية : 43
المشاركات : 388
الجنس : ذكر
تاريخ الميلاد : 1-5-1989
الدعوات : 1
يتابعهم : 13
يتابعونه : 16
قوة السمعة : 3165
الاعجاب : 187
 offline 
look/images/icons/i1.gif تجزئة الاسماء المركبة وفصلها عن الاسماء العادية
المشاركة الأصلية كتبت بواسطة: YasserKhalil
ولا يهمك يا جدو .. تم تحميل آخر تحديث للملف في المشاركة الأصلية وحذفها من المشاركة الفرعية لكي لا يتوه الأعضاء ..
جزاك الله خير الجزاء

0
 مشكور على الجهد وجزاك الله خيراً  حفيدي الغالي
لكن انت قمت بتحميل الملف الجديد  sep_complex_names_New مكان  sep_complex_names 
وهذا فعلاً مطلوب 
ولكن على ما أظن سهواً لم تحمل الماكرو الجديد الذ ي يعتمد على  Match  و ليس Find
مع ان الماكرو الجديد موجود داخل الملف الذي تم تحديثه، لكن ربما احد ما اراد استعمال الماكرو
 و تعديله ليتناسب مع العمل عنده (تغيير نطاق مثلاً) دون تنزيل الملف
فيقع في مشاكل تكرار الجزء الاول من الاسم المركب
الماكرو الجديد 

Option Explicit
Sub New_Split_Name()
Application.ScreenUpdating = False
Dim my_st$, st1, st2
Dim last_col%
Dim my_name, i%, k%, Col%, int_col%
Dim Lr%: Lr = Cells(Rows.Count, 1).End(3).Row
Dim mon_range As Range
Dim fin_rg As Range
Range("b2").Resize(Lr - 1, 10).Clear
Dim arr: arr = _
Array("سيف", "عبد", "أبو", "ابو", "عز", "صدر", "نور")
'++++++++++++++++++++++++++++++++++++++
Rem     Array تستطيع ان تضيف اي بداية اسم مركب داخل هذا الــ
'+++++++++++++++++++++++++++++++++++++
 For i = 2 To Lr
 If Range("a" & i) = vbNullString Then GoTo Next_i
  my_st = Trim(Range("a" & i))
  my_name = Split(Trim(my_st))
  Range("b" & i).Resize(1, UBound(my_name) + 1) = my_name
Next_i:
  Next
  '==============================
 For i = 2 To Lr
   last_col = Cells(i, Columns.Count).End(1).Column
   Set mon_range = Range(Cells(i, 2), Cells(i, last_col))
   For k = 1 To last_col - 1
    If Not (IsError(Application.Match(mon_range.Cells(k), arr, 0))) Then
        st1 = mon_range.Cells(k): st2 = mon_range.Cells(k + 1)
        mon_range.Cells(k).Delete Shift:=xlToLeft
        mon_range.Cells(k) = st1 & " " & st2
    End If
   Next
 Next

   Set fin_rg = Range("a1").CurrentRegion
   Lr = fin_rg.Rows.Count
   Col = fin_rg.Columns.Count
  With fin_rg.Offset(1).Resize(Lr - 1, Col - 1).Offset(, 1)
   .Borders.LineStyle = 1: .Font.Bold = True
   .InsertIndent 1: Columns.AutoFit
   .SpecialCells(2).Interior.ColorIndex = 35
 End With
 Set mon_range = Nothing
 Set fin_rg = Nothing
 Application.ScreenUpdating = True
  '===============================
End Sub



 





21-07-2019 08:53 صباحا
مشاهدة مشاركة منفردة [10]
YasserKhalil
menu_open عضوية موثقة
مراقب عام
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 6650
الجنس : ذكر
تاريخ الميلاد : 1-10-1978
الدعوات : 19
يتابعهم : 0
يتابعونه : 407
قوة السمعة : 18512
الاعجاب : 740
 offline 
look/images/icons/i1.gif تجزئة الاسماء المركبة وفصلها عن الاسماء العادية
تم نسخ الكود في مشاركتك الأخيرة للمشاركة الأولى

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





21-07-2019 09:09 صباحا
مشاهدة مشاركة منفردة [11]
salim
menu_open
خبير معتمد
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 22-08-2017
رقم العضوية : 43
المشاركات : 388
الجنس : ذكر
تاريخ الميلاد : 1-5-1989
الدعوات : 1
يتابعهم : 13
يتابعونه : 16
قوة السمعة : 3165
الاعجاب : 187
 offline 
look/images/icons/i1.gif تجزئة الاسماء المركبة وفصلها عن الاسماء العادية
المشاركة الأصلية كتبت بواسطة: YasserKhalil
تم نسخ الكود في مشاركتك الأخيرة للمشاركة الأولى

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

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





04-08-2019 05:22 مساء
مشاهدة مشاركة منفردة [12]
محسن أحمد عبد الرازق
menu_open
عضو
معلومات الكاتب ▼
تاريخ الإنضمام : 17-07-2019
رقم العضوية : 13856
المشاركات : 3
الجنس : ذكر
تاريخ الميلاد : 13-2-1975
يتابعهم : 1
يتابعونه : 0
قوة السمعة : 10
الاعجاب : 0
 offline 
look/images/icons/i1.gif تجزئة الاسماء المركبة وفصلها عن الاسماء العادية

أساتذتى الأعزاء أرجو توضيح أين يتم وضع الكود وكيفية حفظه فأنا خبرتى بالأكواد منعدمة  
أنا أضغط alt + f11  تفتح مكان الكود بعد ذلك معرفش أعمل إيه كى أستخرج أسم الأب فى ملفات التقدم للمدرسة
أرجو الشرح بإستفاضة حتى أفهم الموضوع







المواضيع المتشابهه
عنوان الموضوع الكاتب الردود الزوار آخر رد
UDF جديد لفصل الاسماء المركبة salim
6 163 الصقر

الكلمات الدلالية
العادية ، الاسماء ، وفصلها ، المركبة ، الاسماء ، تجزئة ،


 







اخلاء مسئولية: يخلى منتدى أكاديمية الصقر للتدريب مسئوليته عن اى مواضيع او مشاركات تندرج داخل الموقع ويحثكم على التواصل معنا ان كانت هناك اى إنتهاكات تتضمن اى انتهاك لحقوق الملكية الفكرية او الادبية لاى جهة - بالتواصل معنا من خلال نموذج مراسلة الإدارة .وسيتم اتخاذ الاجراءات اللازمة.
سياسة النشر: التعليقات المنشورة لا تعبر عن رأي منتدى أكاديمية الصقر للتدريب ولا نتحمل أي مسؤولية قانونية حيال ذلك ويتحمل كاتبها مسؤولية النشر.



الساعة الآن 02:44 صباحا

أعلن هنا
أعلن هنا
أعلن هنا