تقسيم الأسماء الى اعمدة

[دلفين سردار]

بسم الله الرحمن الرحيم

السلام عليكم ورحمة

كيف  حالكم احبتي في لله

جزاكم الله الف خير جميعا ..

اساتذي لدي مشكلة واتمنى ان اجد له حل

لدي ملف وفيه اسماء طالب مدرستنا هذه الاسماء ثلاثيه ارغب في توزيعها الى حقول بحيث كل اسم يذهب الى حقل واسم الاب في حقل واسم الجد في حقل

وهنا ارغب في الاحتفاظ في الاسماء الاصليه ... استخدمت طريقة تحويل نص الى الاعمدة هنا يوزع الى حقول ولكن لا يخدم عمالي

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

ولكم مني كل شكر وتقدير

تقسيم نصوص الى اعمدة.xlsx

[سليم حاصبيا]

جرب هذا الملف

 

 

تقسيم نصوص الى اعمدة salim.xlsm

[shreif mohamed]

تفضل 

 

تقسيم نصوص الى اعمدة.xlsm

[دلفين سردار]

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

هل ممكن شرح كيف تم عمل

لان انا بدي اضيفه الى مشروع خاص بمدرستنا

والمشروع كبير جدا ولا يمكن تحميله

يوجد مشكلة عند اضافة قائمة اسماء لا يقبل التوزيع

فقط يقبل توزيع المفرد اي اكتب اسم اسم

هنالك مشكلة لايقبل ان اضيف قائمة بالكامل

اي يقبل اضافة اسم اسم فقط وليس مجموعة اسماء

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Target.Column = 1 And Target.Row > 2 _
And Target.Columns.Count = 1 Then
  Dim Cell As Range
  Dim Arr
    For Each Cell In Target.Cells
        Cell.Offset(0, 1).Resize(, 4).ClearContents
        Arr = Split(Cell, " ")
        On Error GoTo Next_Cell
        Cell.Offset(0, 1).Resize(, 4).ClearContents
        Cell.Offset(, 1).Resize(, UBound(Arr) + 1) = Arr
        '==================
Next_Cell:
        Erase Arr
    Next

  End If
 Application.EnableEvents = True
End Sub

رد///////

هذا الكود يعمل بواسطة النسخ من عامود اخر(عامود واحد فقط) واللصق( في العامود A)

ابتداءً من الصف رقم 2

 

[سليم حاصبيا]

يوضع هذا الماكرو في حدث الصفحة

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Target.Column = 1 And Target.Row > 2 _
    And Target.Count = 1 Then
    Target.Offset(0, 1).Resize(, 4).ClearContents
    Target.Offset(, 1).Resize(, UBound(Split(Trim(Target), _
    " ")) + 1) = Split(Trim(Target), " ")
  End If
 Application.EnableEvents = True
End Sub

 

[Ali Mohamed Ali]

جزاكم الله كل خير

الشكر موصول للأستاذ سليم والأستاذ شريف

ولإثراء الموضوع هذا كود ثالث

 

تجزئة الاسماء من اسم طويل.xls

[دلفين سردار]

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

وجعله الله في ميزان حسناتكم

الحمدلله تمت العملية بنجاح بوركتم جميعا