كيف احصل على اعلى 10 سجلات موزعة على ورقتين

[المثابر]

السلام عليكم

لدي عمودين: عمود الاسم A1 وعمود الدرجة B1

كيف احصل على اعلى 10 سجلات على اساس حقل الدرجة من بين مجموعة

سجلات موزعة على ورقتي عمل وليس ورقة واحدة ،بحيث ان

الناتج يكتب في ورقة عمل ثالثة

حاولت ارفاق مثال ولكني لم ارى خاصية ارفاق ملف،هل الغيت الخاصية؟.

ولكم خالص الشكر والتقدير

[محمد حجازي]

السلام عليكم ...

جرب التعديل البسيط التالي:

sort.zip

[المثابر]

اخي الكريم..

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

لا اعرف اذا كان من الممكن ايجاد حل ما...

الا نستطيع كتابة صيغة معينة بالدالة max تجلب اعلى عشرة سجلات وتضعها في ورقة منفصلة؟

ولكم خالص الشكر

[محمد حجازي]

السلام عليكم ...

لقد بدأت بكتابة الكود الخاص بمشكلتك و لكني توقفت عند تساؤل :

إذا كان هناك طالبان لهما نفس الدرجة ، هل تريد جعلها في مرتبة واحدة ؟ (مثلاً 2 مكرر)

[المثابر]

السلام عليكم

اخي الكريم..

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

لو تساوت درجتان فالاسلوب المتبع عادة هو ان الاسم الاول ياخذ ترتيبه والثاني يكون بترتيب مكرر.

وشكرا

تم تعديل أبريل 29, 2005 بواسطه المثابر

[محمد حجازي]

السلام عليكم ...

جرب الكود التالي :

Sub Sort_ManySheets()
   Dim MyData() As Double
   Dim i As Long
   Dim ii As Long
   Dim n As Long
   Dim EndRow As Long
   Dim NumberLevels As Long
   Dim EndRowOfMyRange As Long
   NumberLevels = 10
   EndRowOfMyRange = 100
   MySheets = Array("1", "2", "3")
   On Error GoTo OutOfRange
   For Each ThisSheet In MySheets
     For i = 1 To NumberLevels
       ReDim Preserve MyData(UBound(MyData) + 1)
       MyData(UBound(MyData)) = Application.WorksheetFunction.Large(Sheets(ThisSheet).Range("B2:B" & EndRowOfMyRange), i)
     Next i
   Next ThisSheet
   On Error GoTo 0
   Sheets("Result").Range("A2:B65536").ClearContents
   For i = 1 To UBound(MyData)
     If i = 1 Then GoTo 1
     If Application.Large(MyData, i - 1) = Application.Large(MyData, i) Then GoTo 2
1    For Each ThisSheet In MySheets
      With Sheets(ThisSheet)
        For ii = 2 To EndRowOfMyRange
          If .Cells(ii, 2).Value = Application.Large(MyData, i) Then
            EndRow = Sheets("Result").Range("A1").CurrentRegion.Rows.Count
            Sheets("Result").Cells(EndRow + 1, 1) = .Cells(ii, 1).Value
            Sheets("Result").Cells(EndRow + 1, 2) = .Cells(ii, 2).Value
          End If
        Next ii
      End With
     Next ThisSheet
     n = n + 1
     If n = NumberLevels Then Exit Sub
2  Next i
Exit Sub

OutOfRange:
  If Err = 9 Then
    ReDim MyData(0)
    On Error GoTo NoResult
    Resume Next
  End If
    
NoResult:
  If Err = 1004 Then
    ReDim Preserve MyData(UBound(MyData) - 1)
    Resume Next
  Else
    Error Err
  End If
End Sub

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

NumberLevels = 10

هنا يجب عليك تحديد عدد المتسويات التي تريد ظهورها في الورقة Result (الرقم الافتراضي 10) .

EndRowOfMyRange = 100

هنا يجب عليك تحديد رقم آخر سطر في جداول الطلاب الموجودة في الأوراق المختلفة (الرقم الافتراضي 100).

MySheets = Array("1", "2", "3")

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

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

مرفق الملف مع التعديل الأخير :

تحياتي

sort.zip

[المثابر]

اخي الكريم

لقد جربت البرنامج وهو شغال تمام...وجربت اكثر من 500 سجل لكل صفحة

ولم اجد اي مشكلة..

بالنسبة للاعمدة المختارة من الصفحات والتي تظهر في صفحة النتائج وهي

عمود A , B ...لقد اضفت اعمدة اخرى للصفحات ولكن لم يظهر طبعا في صفحة النتائج الا

العمودين اعلاه...كيف يمكنني ان اظهر مثلا الاربعة اعمدة الاولى مثل A,B,C,D او اختار اعمدة معينة غير مرتبة على فرض انه لدي عدة اعمدة..ارجو ان توضح لي اي خطوة من

الكود المسؤولة عن هذه التغييرات.

مع خالص الشكر

[محمد حجازي]

السلام عليكم ...

حسب فهمي لسؤالك فإن حل مشكلتك يكمن في السطرين التاليين :

Sheets("Result").Cells(EndRow + 1, 1) = .Cells(ii, 1).Value
Sheets("Result").Cells(EndRow + 1, 2) = .Cells(ii, 2).Value

و يمكنك هنا إضافة أسطر بعدد الأعمدة الموجودة لديك ، وذلك طبعاً مع الانتباه لتغيير ترتيب العامود (المتغير الثاني في الأسلوب Cells).

جرب ما قلته لك و أخبرني بالنتيجة.

تحياتي

[المثابر]

السلام عليكم

اخي الكريم

قمت بالتحكم في عرض الاعمدة المطلوبة عن طريق جملة

Sheets("Result").Cells(EndRow + 1, 2) = .Cells(ii, 2).Value

حيث اذا اردنا ان نضيف العمود رقم 3 مثلا نضيف هذه الجملة الى الكود و نغير الرقم 2 في طرفي المعادلة في الجملة الى 3

وهكذا نختار رقم العمود حسب الرغبة..

شكرا جزيلا على مساندتك وكثر الله من امثالك

تم تعديل مايو 17, 2005 بواسطه المثابر