اختيار اسماء عشوائية بدون تكرار

[منياوى]

المطلوب فى الملف المرفق ولكم جزيل الشكر

RandomNumbers.rar

[عبدالله باقشير]

السلام عليكم

هذه دالة تعطي نتائج صفيف

للارقام من 1 الى الرقم الذي تحدده في الدالة

في المتغير ContGrob

لتعديل الدالة:

حدد الخلايا من اول صف لوضع الدالة الى آخر صف لوضع الدالة

. اضغط F2 لتحرير الدالة

ثم اضغط CTRL+SHIFT+ENTER

مع ملاحظة ان تكون عدد الصفوف الموضوعه فيها الدالة تساوي

العدد في المتغير ContGrob للدالة.

وايضا لاتقبل التعديل لجزء منها ووللخروج من هذه الحالة

استخدم الزر ESC

Function kh_RndGrob(ByVal ContGrob As Integer, Optional t As Double)

Dim obj

Dim iRnd As Integer, i As Integer

'========================================

Set obj = CreateObject("Scripting.Dictionary")

'========================================

Do

iRnd = Int(Rnd * ContGrob) + 1

If Not obj.Exists(iRnd) Then

i = i + 1

obj.Add iRnd, i

End If

If i = ContGrob Then Exit Do

Loop

kh_RndGrob = WorksheetFunction.Transpose(obj.keys)

Set obj = Nothing

End Function

المرفق 2003ه

RandomNumbers.rar

[منياوى]

رائع والف الف شكر وجزاكم الله كل خير