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

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

إن شاء الله مفيش مشكلة فقط ارفق ملف معبر عن الملف الأصلي وضع به بعض البيانات وإن شاء الله حلها بسيط

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

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

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

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

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

أخي الكريم ناصر جرب الملف التالي Sample UDF.rar

أعتذر إليك أخي العزيز وائل حدث لبس عندي فاعتقدت أنك تريد مسح النقطة التي في نهاية الجملة وليس وضع النقطة عموماً ملحوقة تفضل الكود التالي 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

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

يبدو أنك استخدمت الكود الأول في الرابط .. ركز وانسخ الكود الثاني في الموضوع وغير رقم 5 إلى 8 وجرب مرة أخرى إذا قابلتك مشكلة فقم بإرفاق ملف الإكسيل .. وليس ملف PDF الذي تم تصديره تقبل تحياتي

أخي الكريم وائل لا أذكر أنك ذكرت موضوع النقطة التي في آخر التعريف إلا الآن ..(راجع المشاركة رقم 4 في الموضوع ستجد أنك لم تذكرها) عموماً غير السطر التالي Sheet2.Cells(P + 1, 2).Value = Application.Trim(Replace(Split(Arr(I, 1), ":")(1), ".", ""))

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

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

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

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

أخي الكريم سيف الدين إليك الكود التالي يؤدي الغرض إن شاء الله Sub Goal_Seek() With Sheet1 .Range("P5").GoalSeek Goal:=3000, ChangingCell:=.Range("G5") End With End Sub ضع الكود في موديول عادي ، امسح الخلية G5 ، ثم اضغط Alt + F8 واختر الإجراء الفرعي المسمى Goal_Seek ثم انقر زر الأمر Run ..

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

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

أخي الكريم وائل جرب المرفق التالي .. قم بنسخ بياناتك إلى ورقة العمل الأولى في العمود الأول ثم انقر زر الأمر لتحصل على النتيجة المطلوبة في ورقة العمل الثانية 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

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

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

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

أخي الكريم وائل بناءً على الملف المرفق من قبل أخونا سليم من قبل ..تعاملت مع خلية واحدة فقط وهي الخلية 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

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