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

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

أخي الحبيب أبو يوسف ..يبدو أنه حدث لبس عندي بسبب النظر فلم يكن النطاق أي المدى المشترك واااااحد .. فكل سطر مختلف : السطر الأول والثالث متشابهان بينما الثاني مدى مختلف ..راجع النطاقات .. حيث أن المعادلة توضع في النطاق B1:B10 ويتم مسح المعادلات بعد الفرز B1:B10 بينما عملية الفرز نفسها تتم على النطاق A1:B10

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

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

أخي الحبيب أبو يوسف ..يبدو أنه حدث لبس عندي بسبب النظر فلم يكن النطاق أي المدى المشترك واااااحد .. فكل سطر مختلف : السطر الأول والثالث متشابهان بينما الثاني مدى مختلف ..راجع النطاقات .. حيث أن المعادلة توضع في النطاق B1:B10 ويتم مسح المعادلات بعد الفرز B1:B10 بينما عملية الفرز نفسها تتم على النطاق A1:B10

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

End Sub

السلام عليكم ورحمة الله وبركاته ..هذا ما توصلت إليه أخيراً ...وقد عمل بشكل صحيح والسلام عليكم

أتعبتكم معي...سامحوني.

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

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

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

وإليك حل بأسلوب آخر لنفس الكود

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

تقبل تحياتي

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

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

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

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

وإليك حل بأسلوب آخر لنفس الكود

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

تقبل تحياتي

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

تحب تكمل ولا تعبت ...!

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

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

لو هتقدر تكمل قولي .. لو تعثرت في أي نقطة أنا معاك ...

 

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

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

[رمهان]

عند تساوي الطول النصي وكان شرط الترتيب ابجديا حاضر ! وقد تبدأ الجملة بارقام !!!

 

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

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

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

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

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

وأما المدى الديناميكي ...أكيد بحاجة دراسة.

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

[رمهان]

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

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

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

كيف ما يريدها الاستاذ القدير ابو البراء ؟ 

هي فكرة خطرت في البال بعد قراءة الموضوع الرائع !

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

[الجموعي]

عن طريق المعادلة LEN وعملية الفرز من الأكبرإلى الأصغر

 

 

sort by len character length.rar

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

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

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

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

بالنسبة للنطاق الديناميكي الموضوع في غاية السهولة .. فقط اتبع نصيحتي وأنت تعرف كيفية عمل ذلك:

النطاق المستخدم هو A1:B10

المطلوب : استبدال الرقم 10 ليصبح رقم آخر صف به بيانات في العمود الأول (اللي هو أساس الشغل بتاعنا في المثال)

استخدم الجملة دي مكان رقم 10

Cells(Rows.Count, "A").End(xlUp).Row

يبقى المطلوب تعمله تشيل رقم 10 وبس ..لا تمس التنصيص الموجود .. ولا تمس قوس الإغلاق

وبعد علامة التنصيص وقبل قوس الإغلاق تضع مسافة بالمسطر ثم علامة &  اللي بتيجي من خلال الضغط على Alt + 7 ثم مسافة ... ثم تضع الجملة السحرية اللي أشرت إليها وبس خلاص

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

 

الأخ الحبيب رمهان

اللي يعمل خير ميشورش .. هات ما عندك .. أثري الموضوع بإبداعاتك

 

الأخ الغالي الجموعي

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

تقبلوا جميعاً تحياتي

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

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

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

Sub kTest()
    Dim Rng As Range
    Application.ScreenUpdating = 0
    Columns(1).Insert: Rows(1).Insert
    [a1] = "temp": [b1] = "texts"
    Set Rng = Range("a1", Range("b" & Rows.Count).End(xlUp))
    With Rng
        .Offset(1).Resize(.Rows.Count - 1, 1).Formula = "=len(b2)"
        .Sort .Cells(2, 1), xlDescending, Header:=xlNo
        .Columns(1).Delete
        .Rows(1).Delete
    End With
    Application.ScreenUpdating = 1
End Sub

 

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

السلام عليكم إن صح عملي بنصيحتك يكون الكود على الشكل التالي: "والله أعلم"

Sub SortByLEN()
Application.ScreenUpdating = False

   With Range("B1:B" & Cells(Rows.Count, "A").End(xlUp).Row)
     .FormulaR1C1 = "=LEN(RC[-1])"
      Range("A1:B" & Cells(Rows.Count, "A").End(xlUp).Row).Sort Key1:=Range("B1:B" & Cells(Rows.Count, "A").End(xlUp).Row), Order1:=xlDescending, Header:=xlNo
     .ClearContents
   End With
Application.ScreenUpdating = True

End Sub

 

[محمد الريفى]

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

تقبلوا منى تحياتى

{=INDEX($A$1:$A$10;SMALL(IF(LARGE(LEN($A$1:$A$10);ROW($A1))=LEN($A$1:$A$10);ROW($A$1:$A$10);"");1))}

[أبوبسمله]

طلعت الدرر اللى متخبيه يا ابو البراء

جزاك الله كل خير يالغالى

تقبل تحياتى وسامحنى على التقصير هذا الاسبوع ولكنى ما زلت ابحث وانت تعلم ضيق الوقت الذى امر به حاليا

وفقكم الله لما يحبه ويرضاه

جزاكم الله خيرا اخوانى الكرام على هذا التفاعل البناء

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

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

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

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

أخي وحبيبي الغائب عن العين الحاضر في القلب محمد الريفي ..

لكم أسعد برؤية مشاركاتك بالمنتدى ومشكور على الحل المميز وننتظر منك المشاركة بشكل دائم إن شاء الله

أخي المميز أحمد

يكفينا مرورك العطر بالموضوعات فهي تنثر العبق في المنتدى ..جزاكم الله خيراً

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

[أبوبسمله]

جزاك الله خيرا على كلماتك الطيبه

وربنا يديم المعروف ما بينا كلنا فى اسرة اوفيسنا الطيبه

[محمد الريفى]

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

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

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

أخي وحبيبي الغائب عن العين الحاضر في القلب محمد الريفي ..

لكم أسعد برؤية مشاركاتك بالمنتدى ومشكور على الحل المميز وننتظر منك المشاركة بشكل دائم إن شاء الله

أخي المميز أحمد

يكفينا مرورك العطر بالموضوعات فهي تنثر العبق في المنتدى ..جزاكم الله خيراً

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

استاذى المكرم // ابوالبراء

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

تقبل خالص تحياتى وحبى وتقديرى لك

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

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

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

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

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

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

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

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

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

أسأل الله لي ولك المغفرة والجنة

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

[محي الدين ابو البشر]

السلام عليكم

بعد إذن الاستاذ سليم

تعديل بسيط حسب ما يحب أبو البراء

 

Sort_by_text_len advanced Macro2.rar

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

بارك الله فيك أخي الغالي محي الدين

فينك من أول الأسبوع يا mohadin ... كنا في انتظار مشاركتك من بدري ..

عموماً استعد لموضوع الأسبوع الجديد إن شاء الله .. جزاكم الله خيراً

 

[محي الدين ابو البشر]

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

بارك الله فيك أخي الغالي محي الدين

فينك من أول الأسبوع يا mohadin ... كنا في انتظار مشاركتك من بدري ..

عموماً استعد لموضوع الأسبوع الجديد إن شاء الله .. جزاكم الله خيراً

 

 

الحال من بعضه استاذ YasserKhalil

على كل حال وعكة صحية وانشغال وكهرباء مقطوعة ونت سيئة ... خليها لله

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

ما باليد حيلة ...الله المستعان