كود لترتيب مجموعة من القيم وحساب تكرارها

[مارى]

رجاء المساهمة فى حل هذا الموقف ......

بعد عمل نتيجة لمسابقة كبيرة ظهر الأتى :

عملنا :

م الاسم النسبة البلد

1 عبد الله 90 القاهرة

2 ابراهيم 83 القاهرة

3 منى 75 القاهرة

4 ايمان 75 القاهرة

5 ايمن 70 القاهرة

6 ماجد 60 القاهرة

وكان هذا الجدول كبير لدرجة 800 متسابق , والسؤال هو :

كيف أقوم بترتيب المتسابقين مرة أخرى , بعد عمل عملية الفرز , بمعنى أن عبد الله الأول , وابراهيم الثانى , ومنى الثالث , وايمان الثالث مكرر وايمن الرابع ..... إلخ إلى نهاية الجدول .... بعملية من عمليات الأكسل هل هذا ممكن فى الأكسل .؟؟؟ رجاء التعقيب ولكم كل الشكر ............

[محمد حجازي]

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

من القائمة Data اختاري Sort لتظهر لك نافذة ، في القائمة الأولى حددي عامود النسب واختاري نوع الفرز (تصاعدي ، تنازلي).

[مارى]

لقد عملت عملية فرز وحصلت على الترتيب ولكن احتاج إلى اعادة معرفة كم مستوى ومركز حصل عليه الاول والثانى والثالث والرابع ~~~~~~~~~~~~~~ إلخ

رجاء المساهمة فى الحل

[محمد حجازي]

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

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

Sub Sort111()
On Error GoTo OutRange
Dim MyValue() As Double
Dim MyRange As Range
Dim sort1 As String
Set MyRange = Application.InputBox(prompt:="أدخل مجال النسب", Title:="تصفية", Type:=8)
If MyRange Is Nothing Then Exit Sub
For i = 1 To Application.Count(MyRange)
If MyValue(1, UBound(MyValue, 2)) = Application.WorksheetFunction.Large(MyRange, i) Then
MyValue(2, UBound(MyValue, 2)) = MyValue(2, UBound(MyValue, 2)) + 1
Else
ReDim Preserve MyValue(1 To 2, UBound(MyValue, 2) + 1)
RE:
MyValue(1, UBound(MyValue, 2)) = Application.WorksheetFunction.Large(MyRange, i)
MyValue(2, UBound(MyValue, 2)) = MyValue(2, UBound(MyValue, 2)) + 1
End If
Next i
For n = LBound(MyValue, 2) To UBound(MyValue, 2)
sort1 = sort1 & MyValue(1, n) & "=n(" & MyValue(2, n) & ")، "
Next n
Erase MyValue
MsgBox prompt:=sort1, Title:="النتائج"
Exit Sub

OutRange:
If Err = 9 Then
ReDim MyValue(1 To 2, 0)
GoTo RE
End If
End Sub

ويمكنك لصق النتائج في خلية معينة (عوضاً عن رسالة النتائج) وذلك بتبديل الصف :

MsgBox prompt:=sort1, Title:="النتائج"

إلى:

Sheets(1).Range("D2").Value = sort1

بالتوفيق

تم تعديل فبراير 24, 2005 بواسطه محمد حجازي

[مارى]

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

ثانيا انا ليس عندى خلفيه ولا معرفه ببرنامج فيجول بيزك واريد استخدم اكسيل فقط فى عملى

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

وهنا لا يبقى اماى غير الحل الأول - مهما كان طويل ولكنه يعتبر افضل الحلول . :) :)

ورجاء مساعدتى فى شرح قاعده if الخاصة باكسيل او وضع رابطة تكون قد شرحت القاعدة (y)

واسفة على الإطالة ولكم كل الشكر والتقدير والاحترام

[محمد حجازي]

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

بالنسبة للطريقة التقليدية فهي طويلة وتتطلب صيغة معقدة وهي أبطئ في التنفيذ.

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

لا تنسي تخفيض مستوى الأمان عن طريق: أدوات > مايكرو > الأمان > مستوى منخفض.

بالتوفيق

Sort111.zip

[مارى]

الى الاستاذ الفاضل محمد حجازى :

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

واعتقد ان الخطوة عن طريق فيجول بيسك اسهل واسرع , ولكن عن طريق الكود او المعادلة عن طريقة قاعدة IF تحدد لى عدد المشتركين اكثر وبتسلل افضل , وعلى العموم انا تعلمت الطريقتان الجيدتان جدا فى عملى , :d

جزاك الله بكل الف خير .....

والى كل العاملين بهذا المنتدى الرائع كل التقدير واللاحترام والتقدير (y) (y) (y)

وشكرا على الفيل الذى ساعدنى كثيرا فى الشرح

واتمنى من الله ان يوفقكم فى اداء كل اعمالكم ......................

اختكم فى المنتدى مارى :pp: