كود للفرز

[الشيباني1]

اخواني الاعزاء تحية طيبه ادناه كود يقوم بفرز بيانات وهو يعمل ببطء شديد

هل بالامكان اجراء تعديل عليه ليعمل اسرع مع الامتنان

Private Sub Worksheet_Change(ByVal Target As Range)

Application.Calculation = xlCalculationManual

Application.ScreenUpdating = False

'

Range("B3:x15000").Select

Range(Selection, Selection.End(xlDown)).Select

Range("B3:x15000").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _

Range("aa1:ad2"), Unique:=False

Application.ScreenUpdating = True

Range("B2").Select

Application.Calculation = xlCalculationAutomatic

End Sub

[طارق محمود]

لسلام عليكم

أخي العزيز

أنا فقط أعدت كتابته للتنسيق

وهو يعمل جيدا وبسرعة

Private Sub Worksheet_Change(ByVal Target As Range)

Application.Calculation = xlCalculationManual

Application.ScreenUpdating = False

    Range([B3:x15000], [B3:x15000].End(xlDown)).Select

    [B3:x15000].AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=[AA1:AD2], Unique:=False

Application.ScreenUpdating = True

Application.Calculation = xlCalculationAutomatic

[B2].Select

End Sub

إما ان يكون حجم الملف كبير

أو أن يكون التغيير في هذه الورقة مرتبط بكود تغيير آخر في ورقات أخري

لابد ان تراجع أو ترسل نسخة من الملف كله

وكنصيحة مفيدة يمكنك تقليل الوقت بتحديد المساحة المحتمل التغيير فيها

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

[الشيباني1]

استاذنا العزيز اشكرك جدا وادامك الرحمن لنا مرشدا