اختيار رقم لاظهار اكثر من اسم

[محمد حمدان]

اسماء السائقين ومكان عملهم.zipالسلام عليكم :

لدي جدول باسماء عدد من الاشخاص بالورقة 1 .

واريد من الورقة 2 ان ابحث (او اسجل ) رقم ايا يكن هذا الرقم فيظهر لي بالجدول ادناه عدد الاسماء بعدد الرقم المسجل .

يعني اني لو اخترت الرقم 4 يظهر لي اربع اسماء عشوائية من الجدول .

ولو اخترت رقم اخر وليكن 3    الا يظهر الاسماء السابقة المختارة يعني ان يظهر لي اسماء جديدة غير السابقة . 

ولكم الشكر .

وهذا الملف المرفق

اسماء السائقين ومكان عملهم.zip

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

عسى ان يكون المطلوب

 

اسماء السائقين ومكان عملهم salim.rar

[محمد حمدان]

الله يعطيك العافية 

ويجزيك الخير  .

هل من الممكن ان اعرف ان الاسم الذي تم اختياره .

والا  يظهر في البحث مرة ثانية لانني قد اضطر لاختيار اكثر من رقم 

[رجب جاويش]

بعد اذن أخى الفاضل سليم

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

جرب أخى هذا الكود

Sub ragab()
Dim LR As Integer, LR1 As Integer, i As Integer, x As Integer
Dim sh As Worksheet, cl As Range, TT As Integer, DD As Integer
Set sh = Sheet1
'===================================================================
On Error Resume Next
If IsEmpty(Range("C1")) Or Not IsNumeric(Range("C1")) Then Exit Sub
TT = [C1]
Range("A4:D1000").ClearContents
LR = sh.Range("B1000").End(xlUp).Row - 1
DD = LR - Application.WorksheetFunction.CountIf(sh.Range("E2:E" & LR + 1), "ok")
If DD = 0 Then
MsgBox ("لا يوجد أسماء متاحة للاختيار منها")
Exit Sub
End If
MsgBox ("عدد الأسماء المتاح الإختيار منها " & " " & DD)
If TT > DD Then Exit Sub
1: x = Int(Rnd(1) * LR + 1)
LR1 = Range("A1000").End(xlUp).Row
'===================================================================
If sh.Cells(x + 1, 5) = "ok" Then GoTo 1
For Each cl In Range("A4:A" & LR1)
If cl = x - 1 Then
GoTo 1
Exit For
End If
Next
'===================================================================
For i = 1 To 4
Cells(LR1 + 1, i) = sh.Cells(x + 1, i)
Next
sh.Cells(x + 1, 5) = "ok"
R = R + 1
If R = TT Then Exit Sub
GoTo 1
End Sub

 

اسماء السائقين ومكان عملهم1.rar

[محمد حمدان]

الله يعطيك العافية ويجزيك الخير 

وشكرا كتير كتير كتير 

[رجب جاويش]

على شكر على واجب أخى الفاضل

[قلم-الاكسل(عبدالعزيز)]

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

جزاكما الله كل خير وابعد عنكما كل ضير

حفظكما الحفيظ اينما كنتما

والشكر موصول لطارح الموضوع

هذا ما يعجبني ف المنتدى شخص يقوم بالمعادلات واخر بالاكواد

 

[رجب جاويش]

جزاك الله خيرا أخى الفاضل عبد العزيز

[محمد حمدان]

الله يبارك فيكم على سعة صدركم وحلمكم على اسئلتنا .

مع خالص تحياتنا بالشكر والتوفيق لكم .