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

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

قام بنشر

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

ترتيب البيانات بشروط.rar

قام بنشر

جرب هذا الكود (لنتفيذ الكود بشكل صحيح يجب الا تكون هناك اي خلية فارغة بالجدول باي صف من الصفوف)

Sub Salim_Sort()
Dim sh As Worksheet: Dim lr As Integer

Set sh = ActiveWorkbook.Worksheets("البيانات")
lr = sh.Cells(Rows.Count, 1).End(3).Row
sh.Range("A8").Select
   
 With sh.Sort.SortFields
             .Clear
             .Add Key:=Range( _
                 "E8:E" & lr), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
                 xlSortNormal
            .Add Key:=Range( _
                 "F8:F" & lr), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
                 xlSortNormal
             .Add Key:=Range( _
                 "G8:G" & lr), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
                 xlSortNormal
             .Add Key:=Range( _
                 "H8:H" & lr), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
                 xlSortNormal
             .Add Key:=Range( _
                 "I8:I" & lr), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
                 xlSortNormal
             .Add Key:=Range( _
                 "J8:J" & lr), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
                 xlSortNormal
            .Add Key:=Range( _
                 "L8:L" & lr), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
                 xlSortNormal
   End With
 With sh.Sort
                .SetRange Range("A7:L" & lr)
                .Header = xlYes
                .MatchCase = False
                .Orientation = xlTopToBottom
                .SortMethod = xlPinYin
                .Apply
    End With
End Sub

 

قام بنشر

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

ثانيا انا اريد الترتيب من الاقدم الى الاحدث وحيث ان لنا دلال على العظماء امثالكم ارجو تطبيقه على الملف

اشكر بخالص الوفاء اخى الفاضل سليم حاصبيا على سرعة الرد

لكن الكود لم يعمل معى

قام بنشر (معدل)

اشكرك الشكر الجزيل الاستاذ الغالى سليم ولكن لماذا يحدث بعض العطل بالكود عند الضغط رغم الترحيل الصحيح ؟

 

 

تم تعديل بواسطه نوووووووور
قام بنشر
52 دقائق مضت, نوووووووور said:

اشكرك الشكر الجزيل الاستاذ الغالى سليم ولكن لماذا يحدث بعض العطل بالكود عند الضغط رغم الترحيل الصحيح ؟

 

 

انا جربت الكود عندي و هو يعمل 100%

قام بنشر

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

في المرفق الأخير لأخونا سليم

قم بتنشيط وررقة العمل المسماة "البيانات (2) " ثم اضغط Alt + F8 من لوحة المفاتيح واختر الماكرو المسمى Salim_Sort .. ولن تحدث مشكلة ...

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

Set sh = ActiveWorkbook.Worksheets("البيانات (2)")

تقبل تحياتي

 

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

Sub SortMultipleColumns()
    With ActiveSheet.Sort
        .SortFields.Clear
        
        .SortFields.Add Range("E4"), xlSortOnValues, xlAscending
        .SortFields.Add Range("F4"), xlSortOnValues, xlAscending
        .SortFields.Add Range("G4"), xlSortOnValues, xlAscending
        .SortFields.Add Range("H4"), xlSortOnValues, xlAscending
        .SortFields.Add Range("I4"), xlSortOnValues, xlAscending
        .SortFields.Add Range("J4"), xlSortOnValues, xlAscending
        .SortFields.Add Range("L4"), xlSortOnValues, xlAscending

        .SetRange Range("A7").CurrentRegion.Offset(2)
        .Header = xlYes
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

أرجو أن يفي بالغرض

  • Like 1
قام بنشر

أخي الكريم

الكود يعمل لدي ..ما هي نسخة الأوفيس التي تعمل عليها؟ وما هو الخطأ الذي يظهر معك ..

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

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

 

قام بنشر
4 ساعات مضت, ياسر خليل أبو البراء said:

أخي الكريم

الكود يعمل لدي ..ما هي نسخة الأوفيس التي تعمل عليها؟ وما هو الخطأ الذي يظهر معك ..

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

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

 

السلام عليكم

استاذ ياسر جربت الكود على 2013 يعمل جيداً

لدي سؤال في  السطر 

 For R = 2 To UBound(VA)
                .Item(VA(R, 11)) = .Item(VA(R, 11)) & " " & VA(R, 7)
            Next R

الرقمين 11 و7 من أين جاءا

فقط أحاول أن افهم الكود اذا لم يكن لديك مانع

وجازاك الله كل خير

قام بنشر

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

الرقم 11  والرقم 7 يشيران إلى رقم البعد الثاني في المصفوفة (زي رقم العمود بالضبط) ..لأنها عبارة عن مصفوفة ذات بعدين البعد الأول بعد الصفوف التي يتم التعامل معها والبعد الثاني هو بعد الأعمدة .. راجع الموضوع الذي فيه الكود ، سيسهل عليك فهم الكود ..

 

قام بنشر (معدل)

يا سيدى عند الضغط يذهب الى الكود ويشير الى  .   Sort

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

تم تعديل بواسطه نوووووووور
قام بنشر

مازلت ابحث عن الحل من الاساتذة الكبار فى المنتدى لماذا تظهر عندى مشكلة فى الكود وتظهر علامة صفراء على كلمة sort  فى الكود؟ ولا يتم الترتيب

قام بنشر

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

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

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

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

تقبل تحياتي

قام بنشر

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

أخي وحبيبي محي الدين

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

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

قام بنشر

استاذ ياسر

أنا أسف جداً جداً حداً

أرجو أن تسامحني

 

 

 

 

سامحتني

حسناً

جربت الملف على نةتم 2013 و 2016 كان يعمل تمام التمام

عندما جربته على 2010 وقف عند السطر : 

sh.Range("A8").Select

لا أدري لماذا

فالذي فعلته هو:

sh. activate
Range("A8").Select
اعتذر بشدة مرة أخرى

أ

  • Like 1
قام بنشر

بارك الله فيك وجزاك الله كل خير أخي الحبيب محي الدين ، ولا داعي للاعتذار ..أنا فقط أردت النبيه عليك

تقبل الله منا ومنكم صالح الأعمال ..

تقبل تحياتي

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

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

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

Important Information