أكاديمية الصقر للتدريب

لوحة التميز الأسبوعي
العضو المتميز المشرف المتميز المراقب المتميز المدير المتميز الموضوع المتميز القسم المتميز
العضو المتميز المشرف المتميز المراقب المتميز المدير المتميز الموضوع المتميز القسم المتميز
EM_ACC مجدى يونس-- لا تميز خلال هذه الفترة لا تميز خلال هذه الفترة بحاجة الى كود ترحيل اكسيل اسئله واجابات


أهلا وسهلا بك زائرنا الكريم في أكاديمية الصقر للتدريب، لكي تتمكن من المشاركة ومشاهدة جميع أقسام المنتدى وكافة الميزات ، يجب عليك إنشاء حساب جديد بالتسجيل بالضغط هنا أو تسجيل الدخول اضغط هنا إذا كنت عضواً .





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

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



25-03-2019 01:06 مساء
salim
خبير معتمد
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 22-08-2017
رقم العضوية : 43
المشاركات : 853
الجنس : ذكر
تاريخ الميلاد : 1-5-1989
الدعوات : 1
يتابعهم : 13
يتابعونه : 33
قوة السمعة : 6607
عدد الإجابات: 67
 offline 

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

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.rar   تحميل rar مرات التحميل :(12)
الحجم :(19.966) KB


25-03-2019 01:54 مساء
مشاهدة مشاركة منفردة [1]
ali mohamed ali
مشرف على منتدى الاكسيل
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 20-11-2017
رقم العضوية : 1757
المشاركات : 1763
الدولة : مصر
الجنس : ذكر
الدعوات : 2
يتابعهم : 0
يتابعونه : 68
قوة السمعة : 9632
عدد الإجابات: 46
 offline 
look/images/icons/i1.gif اختيار عشوائي
أحسنت استاذ سليم عمل ممتاز بارك الله فيك
توقيع :ali mohamed ali
{ وَقُل رَّبِّ زِدْنِي عِلْمًا }
[ كن على يقين من اعمالنا نخطئ ومن اخطائنا نتعلم ولذلك لا شي مستحيل ]
ساهم دائماً فى حل أى مشكلة او أستفسار لديك مع إضافة رد بشكره
أو دعوة لمن قدم اليك المساعدة,فالجميع هنا يعمل على مساعدة
 الاخرين لوجه الله وان تحتسب له اجر عند الله

25-03-2019 06:32 مساء
مشاهدة مشاركة منفردة [2]
YasserKhalil
مراقب عام
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 10439
الجنس : ذكر
تاريخ الميلاد : 1-10-1978
الدعوات : 24
يتابعهم : 0
يتابعونه : 533
قوة السمعة : 36372
عدد الإجابات: 252
 offline 
look/images/icons/i1.gif اختيار عشوائي
أحسنت أخي الحبيب سليم وجزاك الله خيراً




الكلمات الدلالية
اختيار ، عشوائي ،


 










اخلاء مسئولية: يخلى منتدى أكاديمية الصقر للتدريب مسئوليته عن اى مواضيع او مشاركات تندرج داخل الموقع ويحثكم على التواصل معنا ان كانت هناك اى إنتهاكات تتضمن اى انتهاك لحقوق الملكية الفكرية او الادبية لاى جهة - بالتواصل معنا من خلال نموذج مراسلة الإدارة .وسيتم اتخاذ الاجراءات اللازمة.
سياسة النشر: التعليقات المنشورة لا تعبر عن رأي منتدى أكاديمية الصقر للتدريب ولا نتحمل أي مسؤولية قانونية حيال ذلك ويتحمل كاتبها مسؤولية النشر.

الساعة الآن 09:48 صباحا