ترتيب الأسماء أو القيم طبقاً لطول السلسلة النصية (موضوع الأسبوع الرابع)

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

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

إخواني وأحبابي في الله ..

روابط الموضوعات للأسابيع الماضية :

*************************

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

مثال للتطبيق عليه :

ضع القيم التالية في النطاق A1:A10

Hi
Yasser
Mohammed
Khaledy
Salah
Baraa Khalil
KAL
Huda
Nader Said
Monalizaa

المطلوب أن تكون النتيجة بهذا الشكل:

Baraa Khalil
Nader Said
Monalizaa
Mohammed
Khaledy
Yasser
Salah
Huda
KAL
Hi

لو قمنا بالاستعانة بعمود مساعد ووضعنا الدالة Len لعرفنا طول السلسلة النصية لكل اسم ..

الحلول يمكن أن تكون بعمود مساعد أو بدون عمود مساعد ، لا أريد تقييد البحث بشيء محدد ..أطلقوا العنان للأفكار والإبداع

وتقبلوا وافر احترامي

[أبوبسمله]

ماشى يا ابو البراء عمال تصعب الامور كل مره عليا بس يالا ولا يهمك

غدا سوف اقوم بالبحث حتى اكون استفقت

جزاك الله كل خير اخى وحبيبى الغالى

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

أخي الحبيب أحمد الفلاحجي

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

بارك الله فيك وجزيت خيراً على متابعتك الجيدة للموضوعات

تقبل تحياتي

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

صباح الخير اخي ابو البراء

توصلت الى احد الحلول (دون الفراغات)

عسى ان ينال الاعجاب (ممكن الاستعانة بالدالة التالية في العامود C -بدل الموجودة)

=IF(A2<>"",LEN(TRIM(A2))+ROW(A1)/1000,"")

 

Sort_by_text_len.rar

تم تعديل مارس 25, 2016 بواسطه سليم حاصبيا

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

أخي الغالي سليم

معادلات ولا أروع .. حل جميل ومبدع بارك الله فيك

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

 

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

23 دقائق مضت, ياسر خليل أبو البراء said:

أخي الغالي سليم

معادلات ولا أروع .. حل جميل ومبدع بارك الله فيك

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

 

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

كل الشكر والتقدير غلى هذا الاطراء مما جعلني اعدّل على المعادلة في العامود D2 (لتتجاوز الفراغات الزائدة في النص )الى هذه المعادلة (طبغاً لازم هنا Crt+Shift + Enter)

والسحب نزولاً

=TRIM(IF(ROWS($B$1:B1)>COUNTA($A$2:$A$100),"",INDEX($A$2:$A$100,MATCH(B2,$C$2:$C$100,0))))

 

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

لحظة من فضلك أخي الحبيب سليم

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

المعادلة الأخيرة في المشاركة السابقة تعمل دون الضغط على Ctrl + Shift + Enter أي أنها ليس بمعادلة صفيف ..تأكد بنفسك وأعلمنا إذا كان كلامي غير صحيح

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

23 دقائق مضت, ياسر خليل أبو البراء said:

لحظة من فضلك أخي الحبيب سليم

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

المعادلة الأخيرة في المشاركة السابقة تعمل دون الضغط على Ctrl + Shift + Enter أي أنها ليس بمعادلة صفيف ..تأكد بنفسك وأعلمنا إذا كان كلامي غير صحيح

 

23 دقائق مضت, ياسر خليل أبو البراء said:

لحظة من فضلك أخي الحبيب سليم

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

المعادلة الأخيرة في المشاركة السابقة تعمل دون الضغط على Ctrl + Shift + Enter أي أنها ليس بمعادلة صفيف ..تأكد بنفسك وأعلمنا إذا كان كلامي غير صحيح

كل الحق معك اخي الحبيب ياسر (غلطة مطبعية ليس الّا)

زيادة في اثراء الموضوع هذا الملف

 

Sort_by_text_len advanced.rar

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

بارك الله فيك أخي الحبيب سليم على الحلول الرائعة والمميزة ..

ننتظر حلول أخرى منك بالأكواد .. بس متنساش تعلن عن المتغيرات وإلا هاخدك مخالفة

 

[محمد حسن المحمد]

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

جزاكم الله خيراً على تفعيل العمل والطلب من الأعضاء الكرام التفاعل الإيجابي بالموارد المتاحة

قمت بدوري بالفرز التنازلي حسب عدد الأحرف باستخدام عمود مساعد يتعلق بعمل الدالة LEN

كمساهمة بسيطة والسلام عليكم.

فرز حسب الأحرف تنازلياً.rar

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

وعليكم السلام أخي الغالي أبو يوسف

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

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

تقبل وافر تقديري واحترامي

 

[محمد حسن المحمد]

الان, ياسر خليل أبو البراء said:

وعليكم السلام أخي الغالي أبو يوسف

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

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

تقبل وافر تقديري واحترامي

 

السلام عليكم طبقت ما ذكرت لي بموديول عن طريق تسجيل ماكرو

أرجو أن ينال إعجابكم

فرز حسب الأحرف تنازلياً.rar

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

وعليكم السلام

بارك الله فيك أخي الحبيب أبو يوسف

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

أريد تحسين لشكل الكود المسجل

من هنا

 

[محمد حسن المحمد]

الان, ياسر خليل أبو البراء said:

وعليكم السلام

بارك الله فيك أخي الحبيب أبو يوسف

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

أريد تحسين لشكل الكود المسجل

من هنا

 

السلام عليكم إن شاء الله تعالى بعد صلاة الجمعة

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

صلاة مقبولة إن شاء الله .. نلتقي بعد صلاة الجمعة

تقبل وافر تقديري وحبي واحترامي

[محمد حسن المحمد]

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

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

Sub SortByLEN()
    Range("B1").Select
    Range("B1").FormulaR1C1 = "=LEN(RC[-1])"
    Selection.AutoFill Destination:=Range("B1:B10")
    Range("A1:B10").Sort Key1:=Range("B1:B10"), Order1:=xlDescending, Header:=xlNo
    Range("B1:B10").ClearContents
End Sub

 

فرز حسب الأحرف تنازلياً.rar

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

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

جميل أخي الحبيب أبو يوسف

وعليكم السلام

والله كدا بقا شكله أحسن ولا ايه رأيك

ندخل على الخطوة التالية وأنا مش مستعجل خلينا نحول الكود لكود صحيح 100% إن شاء الله

ايه رأيك في السطرين دول

Range("B1:B10").Select
    Selection.ClearContents

عايزني نلغي كلمة Select لأنها ملهاش لازمة في معظم الأكواد .. وطبعاً كلمة Selection مرتبطة بيها .. فايه رأيك تشيل الاتنين دول وتخلي السطرين سطر واحد

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

تقبل تحياتي

[محمد حسن المحمد]

الان, ياسر خليل أبو البراء said:

 

Range("B1:B10").Select
    Selection.ClearContents

عايزني نلغي كلمة Select لأنها ملهاش لازمة في معظم الأكواد .. وطبعاً كلمة Selection مرتبطة بيها .. فايه رأيك تشيل الاتنين دول وتخلي السطرين سطر واحد

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

تقبل تحياتي

السلام عليكم ...تم التعديل ..جزاكم الله خيراً

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

مستعجل ليه ..لسه مخلصناش !!

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

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

في انتظار التجربة والتعديل .. ويا ريت تضع التعديل الجديد في مشاركة جديدة ..علشان اللي عايز يتعلم يعرف ايه الخطوات اللي ممكن يعملها عشان يختصر الأكواد ..

تقبل وافر تقديري واحترامي

[محمد حسن المحمد]

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

تأخرت عليك لا تؤاخذني..

Sub SortByLEN()
    Range("B1:B10").FormulaR1C1 = "=LEN(RC[-1])"
    Range("A1:B10").Sort Key1:=Range("B1:B10"), Order1:=xlDescending, Header:=xlNo
    Range("B1:B10").ClearContents
End Sub

بارك الله بكم وبعلمكم ونفع به وجعله ذخراً لكم يوم القيامة ..آمين.

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

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

تمام تمام أخي الغالي أبو يوسف

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

شايف المدى B1:B10 بص في الـ 3 سطور دول .. ولاحظ إن المدى متكرر

فيه خاصية With و القفلة بتاعتها End With دي بنستخدمها امتى ؟ لما يكون هنعمل كذا سطر وفيه شيء مشترك بينهم (المشترك بينهم المدى)

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

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

كوسيلة مساعدة (استعن بالله ثم بالرابط التالي )

من هنا

[محمد حسن المحمد]

المشكلة في هذا السطر

   Range("A1:B10").Sort Key1:=Range("B1:B10"), Order1:=xlDescending, Header:=xlNo

Sub SortByLEN()
   With Range("A1:B10")
     .FormulaR1C1 = "=LEN(RC[-1])"
    .Sort Key1:=Range("B1"), Order1:=xlDescending, Header:=xlNo
     .ClearContents
   End With
End Sub

يرجى المساعدة بتصحيحه..جزاكم الله خيراً.

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

أخي الحبيب أبو يوسف

أبقي على هذا الجزء

Key1:=Range("B1:B10")

أو يمكنك التعديل فيه ليكون بهذا الشكل

Key1:=Range("B1")

 

[محمد حسن المحمد]

للأسف لم يتم الفرز بهذه الطريقة

Sub SortByLEN()
   With Range("A1:B10")
     .FormulaR1C1 = "=LEN(RC[-1])"
     .Sort Key1:=Range("B1"), Order1:=xlDescending, Header:=xlNo
     .ClearContents
   End With

End Sub

 

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

تلبية لطلب اخي وصديقي ابو البراء تم والحمدلله عمل المطلوب بواسطة الكود

انطر الى المرفق صفحة Macro_Sheet

Sort_by_text_len advanced Macro.rar