نقل كلمة محددة بـ : من جملة إلى خلية مجاورة

[ًعبد من عباد الله]

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

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

للرفع

New Microsoft Excel Worksheet1.rar

[عبدالسلام ابوالعوافي]

New Microsoft Excel Worksheet1.rar

[ياسر خليل أبو البراء]

أعتقد أخي وائل نفس الطلب في موضوعك الآخر ..

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

 

[ًعبد من عباد الله]

الأخ الفاضل عبد السلام العوافى

أولا عذرا على التأخير في الرد

ثانيا شكرا لك النتيجة تمام ولكن لى ثلاث مطالب أخرى لو تسمح لى بذلك

1- أن يكون من التنفيذ من خلال كود لكثرة الصفوف.

2- أن تزال المسافة من بداية كلمة التعريف.

3- أن يتم إزالة أو حذف : من كلمة التعريف.

كما هو مشار إليه باللون الأحمر في الصورة المرفقة

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

تم تعديل مايو 6, 2016 بواسطه وائل أبو عبد الرحمن

[ًعبد من عباد الله]

9 ساعات مضت, ياسر خليل أبو البراء said:

أخي الكريم وائل

هل التعامل مع خلية واحدة فقط فيها كل البيانات بهذا الشكل ؟

أم أنه يوجد في صفوف كثيرة في العمود الأول بيانات بهذا الشكل ؟؟

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

في انتظار ردك

تقبل تحياتي

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

[ياسر خليل أبو البراء]

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

ولكن انتبه من الأفضل إرفاق ملف معبر عن المطلوب .. سأرفق لك الملف الذي قمت بإعداده وأخبرني إذا كنت تريد التعديل عليه أم لا ..

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

هذا هو الكود المستخدم (لتنفيذ الكود Alt+ F8 واختر الإجراء المسمى SplitIt)

Sub SplitIt()
    Dim Arr, I As Long, P As Long
    
    Arr = Split(Range("A1").Value, """")
    
    For I = 0 To UBound(Arr) Step 2
        P = P + 1
        
        Cells(P + 1, 1).Value = Application.Trim(Split(Arr(I), ":")(0))
        Cells(P + 1, 2).Value = Application.Trim(Split(Arr(I), ":")(1))
    Next I
End Sub

وها هو الملف المرفق أيضاً

Split By Delimiter YasserKhalil.rar

وها هو ملف مرفق آخر حيث التعامل مع أكثر من خلية واحدة .. ضع البيانات في العمود الأول ثم نفذ الأمر

وإليك الكود المستخدم

Sub SplitIt()
    Dim Arr, I As Long, P As Long, T As Long, LR As Long
    
    LR = Range("A1").CurrentRegion.Rows.Count
    P = LR + 2
    
    For T = 1 To LR
        Arr = Split(Cells(T, 1).Value, """")
        
        
        For I = 0 To UBound(Arr) Step 2
            Cells(P + 1, 1).Value = Application.Trim(Split(Arr(I), ":")(0))
            Cells(P + 1, 2).Value = Application.Trim(Split(Arr(I), ":")(1))
            P = P + 1
        Next I
    Next T
End Sub

أرجو أن يفي بالغرض إن شاء الله

تقبل تحياتي

Split By Delimiter In Multiple Cells YasserKhalil.rar

[ًعبد من عباد الله]

أخى الكريم ياسر خليل أبو البراء

صباح جميل وميارك بإذن الله تعالى

بارك الله فيك كعادتك مذهل ومبدع ودقيق في عملك الكود جميل جدا ولكنه جاء للأسف جاء متأخرا

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

الآن أنا أواجه مشكلتين :-

1- أنى بالفعل قد استخدمت كود أ / سليم في فصل البيانات بالأمس للبيانات الموجودة بين علامتى تنصيص وبقى لها جزئية فصل التعريف فقط مع ملحوظة إزالة المسافة الخالية البادئة في بعض التعريفات وأيضا وضع نقطة نهاية جملة وصف التعريف فإذا كان من الممكن بدون تكليف أن نختصر الكود لهذه الجزئيات فقط وهى مرة أخرى فصل كلمة التعريف وإزالة المسافة الخالية البادئة ووضع نقطة نهاية جملة وصف التعريف أكون شاكرا حتى لا أضطر إلى إعادة كل ما فعلته بالأمس.

2- ليس كل الملف الأصلى بالوورد يفصل بين التعريفات بعلامتى تنصيص يمكن إذا أردت رفعته لك كى تقيمه بنفسك ولكن مساحته بعد الضغط 2.5 ميجا وانتم لا تسمحون بأكثر من 0.9 ميجا.

شكرا لاهتمامك ومتابعتك

تم تعديل مايو 6, 2016 بواسطه وائل أبو عبد الرحمن

[أبو حنــــين]

Sub AAAAAAAAA()

Application.ScreenUpdating = False
    For x = 1 To Range("B" & .Rows.Count).End(xlUp).Row
    For i = 1 To Len(Cells(x, 2))
        If Mid(Cells(x, 2), i, 1) = ":" Then
        Cells(x, 1) = Mid(Cells(x, 2), 1, i - 1) & " :"
        Cells(x, 2) = Mid(Cells(x, 2), i + 1, Len(Cells(x, 2)) - 1) & "."
    GoTo 1
    End If
    Next i
1
Next x
Application.ScreenUpdating = True

End Sub

السلام عليكم

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

 

 

[ياسر خليل أبو البراء]

أخي الكريم وائل

هذا ما أتحدث عنه دائماً ..أنه يجب عند حدوث مستجدات أن ترفق آخر ملف تريد العمل عليه ..وهذا ما لم تقم به أيضاً في مشاركتك الأخيرة ..

الرجاء بعد تجربة كود الأخ الغالي ابو حنين أن ترفق ملفك الأخير الذي تريد التعامل معه والتعديل عليه ...

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

[ًعبد من عباد الله]

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

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

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

 

تم تعديل مايو 6, 2016 بواسطه وائل أبو عبد الرحمن

[ياسر خليل أبو البراء]

أخي الكريم وائل جرب المرفق التالي .. قم بنسخ بياناتك إلى ورقة العمل الأولى في العمود الأول ثم انقر زر الأمر لتحصل على النتيجة المطلوبة في ورقة العمل الثانية

Sub Split_It()
    Dim Arr, I As Long, P As Long

    Application.ScreenUpdating = False
        With Sheet1
            Arr = .Range("A1").CurrentRegion.Value
            
            For I = 1 To UBound(Arr)
                Sheet2.Cells(P + 1, 1).Value = Application.Trim(Split(Arr(I, 1), ":")(0))
                Sheet2.Cells(P + 1, 2).Value = Application.Trim(Split(Arr(I, 1), ":")(1))
                P = P + 1
            Next I
        End With
    Application.ScreenUpdating = False

    MsgBox "Done...", 64
End Sub

تقبل تحياتي

Split By Delimiter YasserKhalil V2.rar

[ًعبد من عباد الله]

أخى الكريم ياسر 

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

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

[ياسر خليل أبو البراء]

أخي الحبيب وائل ..

بالله عليك لا تجعلني أشعر وكأنني أتعامل بدون رفق على الإطلاق ..

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

هذا كل ما في الأمر .. وتقبل اعتذاري وأسفي الشديد إذا كان في قلبك ذرة غضب مني

 

ملحوظة : قبل ردك الأخير بلحظات تم إرفاق ملف بالفعل (يعني لو صبر القاتل ع المقتول كان مات لوحده)

تقبل تحياتي

[أبو حنــــين]

For x = 1 To Range("B" & Rows.Count).End(xlUp).Row

السلام عليكم

اخي وائل الخطأ كان في النقطة في هذا السطر

For x = 1 To Range("B" & .Rows.Count).End(xlUp).Row

تحذف فقط النقطة الموجودة بجانب الكلمة : Rows.Count 

فيصبح هكذا

 

For x = 1 To Range("B" & Rows.Count).End(xlUp).Row

تم تعديل مايو 6, 2016 بواسطه أبو محمد الأمين

[ًعبد من عباد الله]

1 ساعه مضت, ياسر خليل أبو البراء said:

هذا كل ما في الأمر .. وتقبل اعتذاري وأسفي الشديد إذا كان في قلبك ذرة غضب مني

لا تعتذر ولا تتأسف فنحن لا نحبك لعلمك وأهتمامك ومتابعتك لنا فقط بل لأدبك وقلبك الأبيض يا أبو البراء

توكلت على الله فكانت النتيجة كالعادة ررررررررررررررررررررررررائعة ولكن لا يضع نقطة في نهاية جملة وصف التعريف شكرا لك

تم تعديل مايو 6, 2016 بواسطه وائل أبو عبد الرحمن

[ياسر خليل أبو البراء]

الحمد لله الذي بنعمته تتم الصالحات ، والحمد لله أن تم المطلوب على خير ، والحمد لله رب السماوات ورب الأرض ورب العرش العظيم

قل الحمد لله .. ولا تنساني بدعوة بظهر الغيب ، فما أحوجنا لتلك الدعوات

تقبل تحياتي

[ًعبد من عباد الله]

أخى الحبيب أبو محمد أم أبو حنين؟ الأمين (انا اتلغبط خلاص)
تم تنفيذ الكود بعد التعديل بلا مشكلة ولكن يبقى في كودك الملاحظات التى عالجها أخانا الحبيب أبو البراء بكوده الأخير واقترح أن يحدث (مكس) بين الكودين لأنك في كودك عالجت مشكلة النقطة في نهاية جملة وصف التعريف وهو ما افتقده كود أخى ياسر شكرا جزيلا لكما ولا حرمنا الله من محبتكم ومتابعتكم ومساعدتكم لنا

 

تم تعديل مايو 6, 2016 بواسطه وائل أبو عبد الرحمن

[ياسر خليل أبو البراء]

أخي الكريم وائل لا أذكر أنك ذكرت موضوع النقطة التي في آخر التعريف إلا الآن ..(راجع المشاركة رقم 4 في الموضوع ستجد أنك لم تذكرها)

عموماً غير السطر التالي

Sheet2.Cells(P + 1, 2).Value = Application.Trim(Replace(Split(Arr(I, 1), ":")(1), ".", ""))

 

 

[ًعبد من عباد الله]

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

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

16 ساعات مضت, وائل أبو عبد الرحمن said:

ما شاء الله تسلم يديك أ / سليم حاصبيا

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

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

15 ساعات مضت, وائل أبو عبد الرحمن said:

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

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

عموما من غير ضرب أنا نقلت السطر للكود بنجاح (آيه رأيك في تقدم مش كده) ولكن لم يحدث شيء ؟؟؟!!!

تم تعديل مايو 6, 2016 بواسطه وائل أبو عبد الرحمن

[ياسر خليل أبو البراء]

أعتذر إليك أخي العزيز وائل

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

عموماً ملحوقة تفضل الكود التالي

Sub Split_It()
    Dim Arr, I As Long, P As Long

    Application.ScreenUpdating = False
        With Sheet1
            Arr = .Range("A1").CurrentRegion.Value
    
            For I = 1 To UBound(Arr)
                Sheet2.Cells(P + 1, 1).Value = Application.Trim(Split(Arr(I, 1), ":")(0))
    
    
                If Right(Split(Arr(I, 1), ":")(1), 1) = "." Then
                    Sheet2.Cells(P + 1, 2).Value = Application.Trim(Split(Arr(I, 1), ":")(1))
                Else
                    Sheet2.Cells(P + 1, 2).Value = Application.Trim(Split(Arr(I, 1), ":")(1)) & "."
                End If
                P = P + 1
            Next I
        End With
    Application.ScreenUpdating = False

    MsgBox "Done...", 64
End Sub

تقبل تحياتي

 

Split By Delimiter YasserKhalil V3.rar

[ًعبد من عباد الله]

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

على فكرة المنتدى منعنى أن أنا أيديلك إعجاب طلعلى رسالة بتقول أن أنا استنفذت عدد مرات الإعجاب اليومى بعدد 10 إعجابات شفت بقا خلصت عليك رصيدي من الإعجاب أعمل أيه دلوقتى

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

جزاكم الله خير أنت والأخ الفاضل أخوكم في الله (مش ليه بحب الاسم ده أكتر )

[ياسر خليل أبو البراء]

الحمد لله أن تم المطلوب على خير

وبالنسبة للإعجاب فأبو حنين بالنيابة عنك قام بالواجب ..مشكور يا غالي على الإعجاب

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

يمكن نسخ النتائج للورد بعد ذلك أعتقد أنها ليست مشكلة كبيرة

تقبل تحياتي

[ًعبد من عباد الله]

7 ساعات مضت, وائل أبو عبد الرحمن said:

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

الإجابة تجدها في هذا الاقتباس أنا أصلا عايزها بالاكسيل وليس في الوورد ولكن ملف الوورد هو الملف الأصلى وهو 400 صفحة وبعدين يا أخى أعتبرها من باب العلم بالشيء ولا الجهل بيه ولا أنت زهقت منى خلاص

أبو حنين زيك بالضبط كله واجب

 

تم تعديل مايو 6, 2016 بواسطه وائل أبو عبد الرحمن

[ياسر خليل أبو البراء]

أخي الكريم وائل

أنا لم أتهرب منك ..أنا أخبرك أني لا أعلم بالشيء فقط

كنوع من الاحتمالات الممكنة ..

لما لا تقوم بنسخ البيانات من الورد إلى الإكسيل ثم بدء التعامل مع البيانات داخل الإكسيل ، وإذا كانت البيانات كما تذكر فقم بتقسيمها على أكثر من ورقة عمل .. أو أكثر من مصنف ..

مجرد اقتراح

[ًعبد من عباد الله]

أخى الحبيب ياسر

حاولت التلطف بالتبسم معك فقط من قولى لك بالتهرب فلا تأخذه على محمل الجد واعتذر لك إن لم أكن موفقا في استخدام هذا التعبير أنا على علم منذ مشاركتى في هذا المنتدى أنك لا تدخر وسعا في بذل ما لديك من علم في مساعده الجميع.

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

تم تعديل مايو 6, 2016 بواسطه وائل أبو عبد الرحمن