logo

لوحة التميز الأسبوعي
العضو المتميز المشرف المتميز المراقب المتميز المدير المتميز الموضوع المتميز القسم المتميز
العضو المتميز المشرف المتميز المراقب المتميز المدير المتميز الموضوع المتميز القسم المتميز
Hatem Eissa hassona229-- لا تميز خلال هذه الفترة لا تميز خلال هذه الفترة لا تميز خلال هذه الفترة اكسيل مشاريع جاهزه



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





20-07-2019 09:40 مساءً
معلومات الكاتب ▼
تاريخ الإنضمام : 22-08-2017
رقم العضوية : 43
المشاركات : 853
الجنس :
تاريخ الميلاد : 1-5-1989
الدعوات : 1
قوة السمعة : 6611
الاعجاب : 2

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


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


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

CODE
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 مرات التحميل :(39)
الحجم :(21.864) KB


أثارت هذه المشاركة إعجاب: مدحت حافظ، hassona229،



look/images/icons/i1.gif تجزئة الاسماء المركبة وفصلها عن الاسماء العادية
  20-07-2019 10:31 مساءً   [1]
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 10529
الجنس :
تاريخ الميلاد : 1-10-1978
الدعوات : 24
قوة السمعة : 36759
الاعجاب : 186
الله عليك أخي الحبيب سليم
بارك الله فيك وجزاك الله خير الجزاء

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




look/images/icons/i1.gif تجزئة الاسماء المركبة وفصلها عن الاسماء العادية
  20-07-2019 10:35 مساءً   [2]
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 10529
الجنس :
تاريخ الميلاد : 1-10-1978
الدعوات : 24
قوة السمعة : 36759
الاعجاب : 186
لإثراء الموضوع هذه دالة معرفة من ورائع الأخ الحبيب اسلام عبد الله
http://techno7asry.com/forum/t2522

أثارت هذه المشاركة إعجاب: مدحت حافظ،



look/images/icons/i1.gif تجزئة الاسماء المركبة وفصلها عن الاسماء العادية
  20-07-2019 10:43 مساءً   [3]
معلومات الكاتب ▼
تاريخ الإنضمام : 20-11-2017
رقم العضوية : 1757
المشاركات : 1765
الدولة : مصر
الجنس :
الدعوات : 2
قوة السمعة : 9685
الاعجاب : 25
أحسنت استاذ بارك الله فيك وزادك الله من فضله



توقيع :ali mohamed ali


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

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

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

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



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




look/images/icons/i1.gif تجزئة الاسماء المركبة وفصلها عن الاسماء العادية
  21-07-2019 06:50 صباحاً   [6]
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 2
المشاركات : 1824
الجنس :
الدعوات : 21
قوة السمعة : 20048
الاعجاب : 12
موقعي : زيارة موقعي

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




توقيع :الصقر

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


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




look/images/icons/i1.gif تجزئة الاسماء المركبة وفصلها عن الاسماء العادية
  21-07-2019 07:05 صباحاً   [8]
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 10529
الجنس :
تاريخ الميلاد : 1-10-1978
الدعوات : 24
قوة السمعة : 36759
الاعجاب : 186
ولا يهمك يا جدو .. تم تحميل آخر تحديث للملف في المشاركة الأصلية وحذفها من المشاركة الفرعية لكي لا يتوه الأعضاء ..
جزاك الله خير الجزاء




look/images/icons/i1.gif تجزئة الاسماء المركبة وفصلها عن الاسماء العادية
  21-07-2019 08:35 صباحاً   [9]
معلومات الكاتب ▼
تاريخ الإنضمام : 22-08-2017
رقم العضوية : 43
المشاركات : 853
الجنس :
تاريخ الميلاد : 1-5-1989
الدعوات : 1
قوة السمعة : 6611
الاعجاب : 2
المشاركة الأصلية كتبت بواسطة: YasserKhalil ولا يهمك يا جدو .. تم تحميل آخر تحديث للملف في المشاركة الأصلية وحذفها من المشاركة الفرعية لكي لا يتوه الأعضاء ..
جزاك الله خير الجزاء
0
مشكور على الجهد وجزاك الله خيراً حفيدي الغالي
لكن انت قمت بتحميل الملف الجديد sep_complex_names_New مكان sep_complex_names
وهذا فعلاً مطلوب
ولكن على ما أظن سهواً لم تحمل الماكرو الجديد الذ ي يعتمد على Match و ليس Find
مع ان الماكرو الجديد موجود داخل الملف الذي تم تحديثه، لكن ربما احد ما اراد استعمال الماكرو
و تعديله ليتناسب مع العمل عنده (تغيير نطاق مثلاً) دون تنزيل الملف
فيقع في مشاكل تكرار الجزء الاول من الاسم المركب
الماكرو الجديد
CODE

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






look/images/icons/i1.gif تجزئة الاسماء المركبة وفصلها عن الاسماء العادية
  21-07-2019 08:53 صباحاً   [10]
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 10529
الجنس :
تاريخ الميلاد : 1-10-1978
الدعوات : 24
قوة السمعة : 36759
الاعجاب : 186
تم نسخ الكود في مشاركتك الأخيرة للمشاركة الأولى

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




look/images/icons/i1.gif تجزئة الاسماء المركبة وفصلها عن الاسماء العادية
  21-07-2019 09:09 صباحاً   [11]
معلومات الكاتب ▼
تاريخ الإنضمام : 22-08-2017
رقم العضوية : 43
المشاركات : 853
الجنس :
تاريخ الميلاد : 1-5-1989
الدعوات : 1
قوة السمعة : 6611
الاعجاب : 2
المشاركة الأصلية كتبت بواسطة: YasserKhalil تم نسخ الكود في مشاركتك الأخيرة للمشاركة الأولى

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




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

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





اضافة رد جديد اضافة موضوع جديد
الصفحة 2 من 2 < 1 2 >




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

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









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

الساعة الآن 09:03 AM