المشاركة الأصلية كتبت بواسطة: mahmoud ayad سلمت يداك جزاك الله خيرا ... ولكن ع ما اعتقد الكود مش بيعطي نتائج مظبوطه عند اختيار عدد 20 او رقم اقل من 16 يعطي بالعود الاولي 19 والثاني 17
شكراً لك على هذه الملاحظة اخي محمود السبب في ذلك ان الارقام عشوائية و يجوز ان تحصل غلى اخر رقم (في مثلنا هنا 37) لذلك يقوم اكسل بنقل الخلية في الصف
37 +1 العامود (الاول) اي ( my_rg.cells(37 الى الجدول (و كون هذه الخلية فارغة لا يظهر شيء) لان الجدول يبدأ من رقم الخلية رقم 2 A2
لمعالجة هذه المشكلة يتم اضافة سطر صغير الى الكود :
'===========================
If i = lr Then i = lr - 1 وبذلك لا نسمح للرقم ( Lr (37 بالدخول الى الترقيم '===========================
ليصبح الكود بهذا الشكل
CODE
Option Explicit
Sub RANDOM_ELEVES()
If ActiveSheet.Name <> "Salim" Then GoTo Exit_Me
ActiveSheet.Unprotect
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With
Dim lr%: lr = Cells(Rows.Count, 2).End(3).Row
Dim x%: x = [h2]
Dim y%: y = [h3]
If Not IsNumeric(x) Or x < 1 _
Or x Mod 1 <> 0 Or x >= y Then
x = Int(y / 2)
[h2] = x
End If
Range("d2", Range("d1").End(xlDown)).ClearContents
Range("f2", Range("f1").End(xlDown)).ClearContents
Dim My_Rg: Set My_Rg = Range("b2:b" & lr)
Dim g()
ReDim g(1 To lr)
Dim i
Dim k%: k = 1
Do
Randomize
i = Int((lr - 1 + 1) * Rnd + 1)
'===========================
If i = lr Then i = lr - 1 '
'===========================
If g(i) = False Then
g(i) = i
k = k + 1
Cells(k, 4) = My_Rg.Cells(i)
End If
Loop Until k = [h2] + 1
Range("d2:d" & k).SortSpecial Header:=xlNo
k = 2
For i = LBound(g) To UBound(g)
If g(i) = vbNullString Then
Cells(k, 6) = My_Rg.Cells(i)
k = k + 1
End If
Next
Erase g
ActiveSheet.Protect
Exit_Me:
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With
End Sub
الملف الجديد
كيف نختار مجموعة عشوائية من التلاميذ
