اختيار عشوائي

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

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

الكود

Option Explicit
'+++++++++++++++++++++++++++++
Sub choos_randomly()
Dim i%, rd%, x%, _
    k%, y%, Lr%
Dim My_list As Object

If ActiveSheet.Name <> "Salim" Then Exit Sub
Set My_list = CreateObject("System.Collections.ArrayList")
Lr = Cells(Rows.Count, 1).End(3).Row
If Lr < 2 Then Exit Sub
Range("c2", Range("c1").End(4)).ClearContents
'===============================
 If [g2] <= 0 Or Not IsNumeric([g2]) Then
   MsgBox "You Choose a NEGATIVE Number ,Or ZER0 or Empty CELL" & Chr(10) & _
   "I Can't Help You", 1048640
   Exit Sub
 Else
 [g2] = Int([g2])
 End If
'=====================
   With My_list
      For i = 2 To Lr
       If Not .Contains(Range("a" & i).Value) Then
    .Add Range("a" & i).Value
        End If
      Next
       y = .Count
    .Clear
  End With
  If [g2] > y Then
   MsgBox "You Choose an Impossible number" & Chr(10) & _
   " Please Enter a Number <= than " & y, 1048640
   [g2] = vbNullString
   Exit Sub
   End If
     
  '======================
k = 0
With My_list
    Do Until k = [g2]
      If k = y Then Exit Do
     x = (Lr) * Rnd: If x < 2 Then x = 2
        If Not .Contains(Range("a" & x).Value) Then
 .Add Range("a" & x).Value
       k = k + 1
       End If
    Loop
    Range("c2").Resize(.Count) _
    = Application.Transpose(.toarray)
 .Clear
End With

 End Sub

الملف مرفق

 

 

Choose N_Presons from _M.xlsm

[Ali Mohamed Ali]

أحسنت أستاذ سليم عمل ممتاز جعله الله في ميزان حسناتك

[ابو الآء]

بارك الله فيكم

 

[مصطفى محمود مصطفى]

احسنتم جزاكم الله خيرا

 

[مجدى يونس]

افكار ممتازة

[وجيه شرف الدين]

بارك الله فيكم أستاذ سليم عمل ممتاز جعله الله في ميزان حسناتك