اذهب الي المحتوي
أوفيسنا

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


الردود الموصى بها

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

  • Like 1
رابط هذا التعليق
شارك

الان, ياسر خليل أبو البراء 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

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

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

  • Like 2
رابط هذا التعليق
شارك

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

الحمد لله أن تم المطلوب على خير .. هكذا أصبح الكود ناااااااااجح بنسبة 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

تقبل تحياتي

  • Like 2
رابط هذا التعليق
شارك

الان, ياسر خليل أبو البراء 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

تقبل تحياتي

56bdcb6f48437_.gif.1905189268d6221fea7b156bdcb6f48437_.gif.1905189268d6221fea7b156bdcb6f48437_.gif.1905189268d6221fea7b156bdcb6f48437_.gif.1905189268d6221fea7b1

  • Like 2
رابط هذا التعليق
شارك

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

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

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

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

 

  • Like 2
رابط هذا التعليق
شارك

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

  • Like 1
رابط هذا التعليق
شارك

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

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

  • Like 1
رابط هذا التعليق
شارك

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

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

تم تعديل بواسطه محمد حسن المحمد
  • Like 3
رابط هذا التعليق
شارك

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

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

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

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

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

تم تعديل بواسطه رمهان
  • Like 2
رابط هذا التعليق
شارك

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

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

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

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

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

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

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

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

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

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

 

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

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

 

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

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

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

  • Like 3
رابط هذا التعليق
شارك

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

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

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

 

  • Like 2
رابط هذا التعليق
شارك

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

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

 

  • Like 2
رابط هذا التعليق
شارك

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

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

{=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))}

1458995868261.png

  • Like 4
رابط هذا التعليق
شارك

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

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

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

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

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

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

  • Like 2
رابط هذا التعليق
شارك

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

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

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

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

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

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

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

  • Like 3
رابط هذا التعليق
شارك

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

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

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

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

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

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

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

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

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

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

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

  • Like 3
رابط هذا التعليق
شارك

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

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

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

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

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

  • Like 2
رابط هذا التعليق
شارك

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

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

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

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

  • Like 2
رابط هذا التعليق
شارك

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

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

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

 

  • Like 1
رابط هذا التعليق
شارك

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

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

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

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

 

 

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

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

رابط هذا التعليق
شارك

من فضلك سجل دخول لتتمكن من التعليق

ستتمكن من اضافه تعليقات بعد التسجيل



سجل دخولك الان
  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information