طلب التعديل في الكود لترتيب من أعلى معدل عام إلى أصغر معدل عام في كل الملفات

[hicham2610]

السلام عليكم

من فضلكم

طلب التعديل على الكود التالي:

Sub insertformula()
Application.ScreenUpdating = 0
Dim strfile As String, objBook As Workbook, lr As Long, c As Integer
strfile = Dir(ThisWorkbook.Path & "\*.xlsx", vbNormal)
While strfile <> ""
Set objBook = Workbooks.Open(ThisWorkbook.Path & "\" & strfile)
c = objBook.Sheets("data").Range("b10").CurrentRegion.Columns.Count
lr = objBook.Sheets("data").Range(IIf(c = 10, "j", "l") & Rows.Count).End(xlUp).Row
objBook.Sheets("data").Range(IIf(c = 10, "k", "m") & "12").Formula = "=IF(Or(" & IIf(c = 10, "j", "l") & "12<5," & IIf(c = 10, "j", "l") & "12=""ن.م.ر""),""يكرر"",""ينتقل"")"
objBook.Sheets("data").Range(IIf(c = 10, "k", "m") & "12").AutoFill Destination:=objBook.Sheets("data").Range(IIf(c = 10, "k", "m") & "12:" & IIf(c = 10, "k", "m") & lr)
objBook.Sheets("data").Range("b12").Select
objBook.Close 1
strfile = Dir()
Wend
Application.ScreenUpdating = 1
MsgBox "Done"
End Sub

بحيث قبل Msgbox"Done

يقوم الكود بإعادة الترتيب على أساس المعدل العام من أكبر معدل عام إلى أصغر معدل عام

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

3.rar

[hicham2610]

السلام عليكم

هل من اقتراحات إخوتي الكرام؟

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

وحزاكم الله خيرا

[hicham2610]

السلام عليكم

عيدكم مبارك سعيد 

تقبل الله منا ومنكم

Sub formulettrier()
Application.ScreenUpdating = 0
Dim strfile As String, objBook As Workbook, lr As Long, c As Integer, rg As Range
strfile = Dir(ThisWorkbook.Path & "\*.xlsx", vbNormal)
While strfile <> ""
Set objBook = Workbooks.Open(ThisWorkbook.Path & "\" & strfile)
c = objBook.Sheets("data").Range("b10").CurrentRegion.Columns.Count
lr = objBook.Sheets("data").Range(IIf(c = 10, "j", "l") & Rows.Count).End(xlUp).Row
objBook.Sheets("data").Range(IIf(c = 10, "k", "m") & "12").Formula = "=IF(Or(" & IIf(c = 10, "j", "l") & "12<5," & IIf(c = 10, "j", "l") & "12=""ن.م.ر""),""يكرر"",""ينتقل"")"
objBook.Sheets("data").Range(IIf(c = 10, "k", "m") & "12").AutoFill Destination:=objBook.Sheets("data").Range(IIf(c = 10, "k", "m") & "12:" & IIf(c = 10, "k", "m") & lr)

    'البحث عن عمود المعدل العام للفلترة
    Set rg = Rows("10:10").Find(What:="المعدل العام", LookAt:=xlWhole)
 
    AutoFilter.Sort.SortFields.Clear
    AutoFilter.Sort.SortFields.Add
        Key:=rg, _
        SortOn:=xlSortOnValues, _
        Order:=xlDescending, _
        DataOption:=xlSortNormal
    With .AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End With

objBook.Sheets("data").Range("b12").Select
objBook.Close 1
strfile = Dir()
Wend
Application.ScreenUpdating = 1
MsgBox "هشام:تمت عملية إضافة القرار والترتيب من أعلى معدل إلى أقل معدل "
End Sub

من فضلكم أساتذة

ما العيب في هذا الكود لإنجاز ترتيب من أعلى معدل عام إلى أقل معدل عام في كل الملفات 

خاصة ابتداء من :

'البحث عن عمود المعدل العام للفلترة

في الكود السابق

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

[أ / محمد صالح]

جميل جدا 

إن تقوم بتسجيل ماكرو لما تريده 

وتحاول دمجه في الكود الاصلي

واقترح عليك حتى يتم التنفيذ على الملف المفتوح 

إن تضيف

objBook.Sheets("data")

قبل كلمة range او كلمة autofilter او كلمة rows 

عيدكم مبارك 

[hicham2610]

شكرا جزيلا لردك الطيب

أصبحت تخرج لي نافذة الخطإ في:

        Key:=rg, _SortOn:=xlSortOnValues, _Order:=xlDescending, _DataOption:=xlSortNormal

ما حل هذه المشكلة جزاكم الله خيرا

[أ / محمد صالح]

جرب الصف 11 في تعريف rg لأن المعدل العام خلية مدمجة وتأكد من كتابتها في الخلية بهذه الصورة فربما يكون بعدها مسافة زائدة 

[hicham2610]

أخي الكريم

لا توجد مسافة، أصلا في الأول لكي تكون مطابقة أخدتها بنسخ من الملف ولصقتها بالكود (عبارة المعدل العام)

[أ / محمد صالح]

الصواب في الفرز على الصف 11 ولكن

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

فأصبحت الخلايا b11 , c11, d11, j11, k11 فارغة مما يجعل عملية الفرز غير دقيقة

ولذا أضفت كود فك الدمج لهذه الخلايا قبل كود الفرز

Sub insertformula3()
Application.ScreenUpdating = 0
Dim strfile As String, col As String, col1 As String, objBook As Workbook, lr As Long, c As Integer
strfile = Dir(ThisWorkbook.Path & "\*.xlsx", vbNormal)
While strfile <> ""
Set objBook = Workbooks.Open(ThisWorkbook.Path & "\" & strfile)
c = objBook.Sheets("data").Range("b10").CurrentRegion.Columns.Count
col = IIf(c = 10, "j", "l")
col1 = IIf(c = 10, "k", "m")
lr = objBook.Sheets("data").Range(col & Rows.Count).End(xlUp).Row
objBook.Sheets("data").Range(col1 & "12").Formula = "=IF(Or(" & col & "12<5," & col & "12=""ن.م.ر""),""يكرر"",""ينتقل"")"
objBook.Sheets("data").Range(col1 & "12").AutoFill Destination:=objBook.Sheets("data").Range(col1 & "12:" & col1 & lr)

If objBook.Sheets("data").AutoFilterMode Then Selection.AutoFilter
objBook.Sheets("data").Range("b10:b11").UnMerge
objBook.Sheets("data").Range("b11").Value = "رقم التلميذ"
objBook.Sheets("data").Range("b10").ClearContents
objBook.Sheets("data").Range("c10:c11").UnMerge
objBook.Sheets("data").Range("c11").Value = "الاسم والنسب"
objBook.Sheets("data").Range("c10").ClearContents
objBook.Sheets("data").Range("d10:d11").UnMerge
objBook.Sheets("data").Range("d11").Value = "النوع"
objBook.Sheets("data").Range("d10").ClearContents
objBook.Sheets("data").Range(col & "10:" & col & "11").UnMerge
objBook.Sheets("data").Range(col & "11").Value = "المعدل العام"
objBook.Sheets("data").Range(col & "10").ClearContents
objBook.Sheets("data").Range(col1 & "10:" & col1 & "11").UnMerge
objBook.Sheets("data").Range(col1 & "11").Value = "قرار المجلس"
objBook.Sheets("data").Range(col1 & "10").ClearContents

objBook.Sheets("data").Rows("11:11").AutoFilter
objBook.Sheets("Data").AutoFilter.Sort.SortFields.Clear
objBook.Sheets("Data").AutoFilter.Sort.SortFields.Add2 Key:=Range(IIf(c = 10, "j11", "l11")), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With objBook.Sheets("Data").AutoFilter.Sort
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With

objBook.Sheets("data").Range("b12").Select
objBook.Close 1
strfile = Dir()
Wend
Application.ScreenUpdating = 1
MsgBox "هشام:تمت عملية إضافة القرار"
End Sub

عيدكم مبارك

[hicham2610]

الأستاذ الكريم

أ / محمد صالح

جزاك الله خيرا وأحسن إليك.

عيدكم مبارك سعيد

[أ / محمد صالح]

جميعا بإذن الله 

بالتوفيق