طريقه لترتيب الارقام عشوائي

[احمد تاج الدين]

السلام عليكم ورحمة الله وبركاته

 

محتاج طريقه لترتيب الارقام عشوائي 

[Ali Mohamed Ali]

اهلا بك اخ كريم فى المنتدى

كان عليك القيام برفع ملف

لكنى قمت بعمل هذا الملف لك للترتيب العشوائى ,ورقة بالكود وورقة بالمعادلة

تفضل

 

ترتيب عشوائى للأرقام.xlsm

[سليم حاصبيا]

بعد اذن اخي علي هذا الملف

 

Conditional_Rand.xlsm

[Ali Mohamed Ali]

احسنت استاذ سليم بارك الله فيك وزادك من فضله

[احمد تاج الدين]

بارك الله فيك استاذ على وجزاك الله كل خير 

شكرا استاذ سليم بارك الله فيك 

ملف استاذ على هو المطلوب 

[سليم حاصبيا]

زيادة في اثراء الموضوع هذا الملف مع كود سريع جداً (10000 رقم في 0.8 من الثانية)

تختار منها ما تريد

 

Sorting_Rand.xlsm

[احمد تاج الدين]

بارك الله فيك  استاذ سليم  شكرا لمجهودك ملف ممتاز جدا 

ملحوظه الملف يقوم بترتيب الارقام بالترتيب وليس عشوائي ما السبب 

 

Sorting_Rand.xlsm

[سليم حاصبيا]

7 ساعات مضت, احمد تاج الدين said:

بارك الله فيك  استاذ سليم  شكرا لمجهودك ملف ممتاز جدا 

ملحوظه الملف يقوم بترتيب الارقام بالترتيب وليس عشوائي ما السبب 

 

Sorting_Rand.xlsm

ا نت طلبت ذلك من خلال قولك محتاج طريقه لترتيب الارقام عشوائي 

شرح عمل الكود:

=======================================================

 الكود يأخذ مجموعة عشوائية محددة (حسب الطلب ) من الاعداد بين  عددين ومن ثم يرتبها تصاعديا

مثلاُ بين 50 و 500   المطلوب 5 أعداد

احد النتائج المحتملة    (من بين ألوف الألوف)   350  425  100 260  61

الكود يكتبها هكذا : 61     100    260    350   425       هنا ليس ترتيب لارقام متسلسلة  بل ترتيب تصاعدي لارقام عشوائية

 للمزيد يرجى الاطلاع على هذا الملف في العنوان التالي:

https://www.officena.net/ib/topic/85730-كيف-نختار-مجموعة-عشوائية-من-التلاميذ/

===================================================================

اذا كنت لا تريد الترتيب احذف او ( علّق) السطر الرابع من الاسفل  من الكود ليصبح هكذا

Option Explicit
 Sub Sorting_Rand_Numbers()
Dim i%, k%
Dim myStart%: myStart = Application.Min([c2], [d2])
Dim myEnd%: myEnd = Application.Max([c2], [d2])
Dim a()
Range("b:b").ClearContents
Dim x: x = [e2]
If Not IsNumeric(x) Or IsEmpty(x) Then _
MsgBox "Wrong input in $E$2": Exit Sub
If x < 1 Or Int(x) <> x Or x > myEnd - myStart + 1 Then
 x = myEnd - myStart
 [e2] = x
 End If
ReDim a(myEnd - myStart)
 With CreateObject("System.Collections.SortedList")
    Randomize
      For i = myStart To myEnd
       .Item(Rnd) = i
       Next i
         For i = 0 To .Count - 1
      a(i) = .GetByIndex(i)
      Next
  End With
  With Range("b2")
  .Resize(UBound(a) + 1).Value = Application.Transpose(a)
   .Offset(x).Resize(myEnd - myStart + 1 - x).ClearContents
'   .Resize(x).SortSpecial
  End With
  Erase a
End Sub

 

[احمد تاج الدين]

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

وهل يمكن زيادة العدد مثلا 200 الف لانى جربت وبتظهر رسالة overflow

 

تم تعديل أكتوبر 4, 2018 بواسطه احمد تاج الدين