دالة تعمل ترتيب تنازلي آليا كلما تغيرت الأرصدة

[الموسطي]

لدي ملف إكسل به وفيه أرصدة عملاء تتغير كل وقت بحسب سدادات العملاء ومسحوباتهم فأريد أن يتم آليا ترتيب تنازلي إما دالة أو كود

عملاء.xlsx

[hegazee]

تفضل أخي الكريم مع التحكم بنوع الفرز و البيانات التي تريد فرزها

فرز عملاء.xlsm

[الموسطي]

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

[عبدالله بشير عبدالله]

السلام عليكم 

اذا تقصد الفرز من الاعلى رصيد الى الاقل رصيد استخدم الكود التالي

Sub ترتيب_تنازلي()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets("ورقة1")

    With ws
        .Range("A4:E6").Sort Key1:=.Range("E4:E6"), Order1:=xlDescending, Header:=xlNo
    End With
End Sub

ويمكنك نعديل نطاق البيانات من الكود

الملف

عملاء.xlsb

[محمد هشام.]

جرب هدا 

Option Explicit
Sub SortData()
    Dim WS As Worksheet: Set WS = Sheets("ورقة1")
    Dim lastRow As Long, tmp As Long, col As Variant
    Application.ScreenUpdating = False
    tmp = 0
    On Error Resume Next
    tmp = WS.Columns("B").Find("الإجمالي", LookIn:=xlValues, LookAt:=xlWhole).Row
    On Error GoTo 0
    If tmp > 0 Then
        lastRow = tmp - 1
        WS.Range("B4:E" & lastRow).Sort Key1:=WS.Range("E4:E" & lastRow), Order1:=xlAscending, Header:=xlNo
    End If
    For Each col In Array("C", "D", "E")
      With WS.Cells(tmp, col)
        .Formula = "=SUM(" & col & "4:" & col & lastRow & ")": .Value = .Value
      End With
    Next col
    Application.ScreenUpdating = True
End Sub

فرز عملاء.xlsm

تم تعديل فبراير 6 بواسطه محمد هشام.

[الموسطي]

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

 على ملفي الخاص فأرجو منكما تطبيق الكود على ملفي علما بأن الحقل المراد فرزه هو l6-l80 

مديونية 2025م.xls

[الموسطي]

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

مديونية 2025م.xls

[عبدالله بشير عبدالله]

3 ساعات مضت, الموسطي said:

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

 على ملفي الخاص فأرجو منكما تطبيق الكود على ملفي علما بأن الحقل المراد فرزه هو l6-l80 

 

جرب الملف  تم العمل على  ورقة1

مديونية 2025م.xls

تم تعديل فبراير 9 بواسطه عبدالله بشير عبدالله

[الموسطي]

الملاحظ أن الكود لا يعمل حيث أن العمود المراد فرزه هو l6-l75 ولكن لا يتم الفرز حيث هناك أرقام كبيرة تحت وأرقام مصفرة بالوسط فأرجو التعديل على الكود 

[الموسطي]

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

المصنف4.xlsx

[عبدالله بشير عبدالله]

اخونا الفاضل 

الكود الظاهر في الصورة ليس هو الكود الموجود في اخر ملف ارفقته اليك 

المشكلة انك كل مرة ترفق ملف مخنلف عن الاخر وهذا يلزم التعديل على الكود

هذا طلبك في مشاركتك ما قيل الاخيرة

في 9‏/2‏/2025 at 09:57, الموسطي said:

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

 على ملفي الخاص فأرجو منكما تطبيق الكود على ملفي علما بأن الحقل المراد فرزه هو l6-l80 

 

كان طلبك فرز البيانات  l6-l80

تم ارفاق ملف بالكود يقوم بالفرز حسب النطاق والعمود

ثم تغير طلبك في ملفك الاخير  تطاق فرز البيانات  l8-l73 لان الصف 74 اصيح مجاميع للاعمدة

واصبح  الصف 6 رؤوس عناوين وبه خلايا مدمجة فمن الطبيعى ظهور الخطأ

اليك كود يتعامل مع اخر ملف ارفقته انت ويعمل جيدا I8:I73

Sub SortData()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets("ورقة1")

    With ws.Sort
        .SortFields.Clear
        .SortFields.Add Key:=ws.Range("I8:I73"), Order:=xlDescending
        .SetRange ws.Range("A8:AH73")
        .Header = xlNo
        .Apply
    End With
End Sub

الملف

المصنف4.xlsb

 

تم تعديل فبراير 10 بواسطه عبدالله بشير عبدالله

[الموسطي]

تسلم أستاذنا الغالي
هل لي بسؤال أخير: كيف أستطيع نقل كود من ملف إلى آخر ويختلف معه في الامتداد وعمود الفرز؟

[عبدالله بشير عبدالله]

السلام عليكم

8 ساعات مضت, الموسطي said:

هل لي بسؤال أخير: كيف أستطيع نقل كود من ملف إلى آخر ويختلف معه في الامتداد وعمود الفرز؟

ساشرح لك بمثال 

لنفرض ان الملف 1 به الكود الثالي

Sub SortData()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets("ورقة1")

    With ws.Sort
        .SortFields.Clear
        .SortFields.Add Key:=ws.Range("I8:I73"), Order:=xlDescending
        .SetRange ws.Range("A8:AH73")
        .Header = xlNo
        .Apply
    End With
End Sub

وتريد تقل الكود الى الملف  2 حيث تريد عمود الفرز مثلا العمود  M واول صف به بيانات هو الصف 10 واخر صف به بيانات هو الصف 120 واول عمود به بيانات  B واخر عمود به بيانات هو العمود  BA

الخطوات :-

تعديل الكود ليتناسب مع التغيرات في الملف 2

السطر في الكود             .SortFields.Add Key:=ws.Range("I8:I73"), Order:=xlDescending
السطر السابق خاص بالعمود المطلوب فرزه  I8  تعنى  بداية فرز البيانات  الصف 8 للعمود  I    تهاية الفرز لتفس العمود الصف 73

الان تريد ان تعدل في السطر حسب الملف2 

الملف 2   المطلوب عمود الفرز M واول صف به بيانات هو الصف 10    فتكتب بدل  M10  -I8  واخر صف 120 فنستبدل  M120 - I73  فيكون السطر النهائي

             .SortFields.Add Key:=ws.Range("M10:M120"), Order:=xlDescending

وكذلك يتم التغيير في السطر
 

        .SetRange ws.Range("A8:AH73")                 هذا النطاق يحتوي على جميع الخلايا من العمود A إلى AH ومن الصف 8 إلى 73.

,والملف 2  الخلايا  من العمود Bإلى BAومن الصف 10إلى 120.

فيصبح     SetRange ws.Range("B10:BA120")      
فيصبح الكود النهائي

Sub SortData()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets("ورقة1")

    With ws.Sort
        .SortFields.Clear
        .SortFields.Add Key:=ws.Range("M10:M120"), Order:=xlDescending
        .SetRange ws.Range("B10:BA120")
        .Header = xlNo
        .Apply
    End With
End Sub

بالتوفيق

تم تعديل فبراير 11 بواسطه عبدالله بشير عبدالله

[الموسطي]

تسلم بس هل لا بد من تغيير اسم الكود من الملف 1و2

[عبدالله بشير عبدالله]

 

يتغير اسم الكود في حالة وجود كود اخر بتفس الاسم وعدا ذلك يبقى بنفس الاسم

[الموسطي]

تسلم يا أستاذنا الغالي
طيب لو حاولت أغير الكود من الترتيب التنازلي إلى التصاعدي أيش بتغير في صيغة الكود أعلاه؟

[عبدالله بشير عبدالله]

السلام عليكم استبدل السطر 

        .SortFields.Add Key:=ws.Range("I8:I73"), Order:=xlDescending

بهذا السطر

        .SortFields.Add Key:=ws.Range("I8:I73"), Order:=xlAscending

لاحظ الكلمة الاخيرة تغيرت

طبعا  هذا الترتيب  للنطاق I8:I73

بالتوفيق