دالة تقوم بعمل ترتيب عشوائى لقيم معطاة

[ياسر نوح]

الغرض منها مثلا استخدامها لعمل ارقام سرية 

مثلا قيمة من 1 الى 100 

اريد الاعداد من واحد الى 100 مرتبة تربياً عشوائيا 

وداخل نفس النطاق 

[مختار حسين محمود]

استخدم الدالة

=RANDBETWEEN(1;100)

تحياتى

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

 استاذ مختار /الدّالة التي اعطيتها يمكن ان تكرر المعطيات

اليكم هذا الكود لهذا الغرض

Sub rand_without_rep()

Dim myrng As Range, cel As Range, x As Double

Set myrng = Range("A1:A100") 'ممكن التغيير
myrng.Value = ""
If myrng.Count > 100 Then Exit Sub
Randomize
For Each cel In myrng
1 x = WorksheetFunction.RandBetween(1, 100)
If Application.CountIf(myrng, x) Then GoTo 1 Else cel = x
Next

End Sub

 

[ياسر خليل أبو البراء]

بارك الله فيكم إخواني الكرام

إثراءاً للموضوع

في الخلية A1 ضع المعادلة التالية

=RAND()

اسحب المعادلة حتى الخلية A100

 كدا العمود A بنسميه عمود مساعد

 

في الخلية B1 اكتب المعادلة التالية واسحبها لحد B100

=RANK(A1,$A$1:$A$100)

بس خلاص ..

تقبلوا تحياتي

[ياسر خليل أبو البراء]

حل آخر

ضع المعادلة التالية في الخلية A2

=LARGE(ROW($1:$100)*NOT(COUNTIF($A$1:A1,ROW($1:$100))),RANDBETWEEN(1,101-ROW(A1)))

واضغط Ctrl + Shift + Enter

واسحب المعادلة لحد الخلية A101

بس خلاص

تقبل تحياتي

[ياسر خليل أبو البراء]

وهذا حل آخر بالأكواد

Sub RandBewteenTwoNumbersNoDuplicates()
'[A1:A100] يقوم الكود بتوليد أرقام عشوائية ما بين الرقم واحد ومائة في النطاق
'---------------------------------------------------------------------------
    Dim B(100), C, R
'حلقة تكرارية تنتهي بمجرد الوصول لرقم الصف 100 في العمود الأول
    Do
'دالة توليد أرقام عشوائية ما بين 1 و 100
      C = Application.RandBetween(1, 100)
'مصفوفة بها 100 عنصر [B] يمثل المتغير
'[B] داخل المصفوفة [C] هنا يتم اختبار أو فحص العنصر
'إذا لم يكن العنصر داخل المصفوفة
        If Not B(C) Then
'هذا السطر يمثل رقم الصف
            R = R + 1
'[C] الخلية في الصف رقم كذا في العمود الأول تساوي العنصر
            Cells(R, "A") = C
'للعنصر الذي تم وضعه ضمن القيم ليتم استبعاده في حالة التكرار [True] تعيين القيمة
            B(C) = True
        End If
    Loop Until R = 100
End Sub

عشان متقولوش إني حارمكم من حاجة

تقبلوا تحياتي

[مختار حسين محمود]

أشكرك أستاذى الفاضل سليم  على الإضافة

كما أشكر أخى وأستاذى ياسر على الزيادة .

[ياسر نوح]

شكرا أساتذتى الفضلاء 

شكرا لكم جميعا 

 

لكن للأسف سوف اهتم بالمعادلات الان بسسب Language DLL VBE6INTL.DLL

عشان عندى مشكلة يا ريت يكون لييها عندكم حل بالنسبة للفيجوال بيسك عندى مش شغال بسب انه ملف اعتقد مش موجود عندى وهو Language DLL VBE6INTL.DLLLanguage DLL VBE6INTL.DLL

يا ريت لو فيه حل بل ما اغير الويندوز