logo

لوحة التميز الأسبوعي
العضو المتميز المشرف المتميز المراقب المتميز المدير المتميز الموضوع المتميز القسم المتميز
العضو المتميز المشرف المتميز المراقب المتميز المدير المتميز الموضوع المتميز القسم المتميز
Hatem Eissa hassona229-- لا تميز خلال هذه الفترة لا تميز خلال هذه الفترة لا تميز خلال هذه الفترة اكسيل مشاريع جاهزه



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





25-03-2019 01:06 مساءً
معلومات الكاتب ▼
تاريخ الإنضمام : 22-08-2017
رقم العضوية : 43
المشاركات : 853
الجنس :
تاريخ الميلاد : 1-5-1989
الدعوات : 1
قوة السمعة : 6611
الاعجاب : 2
عندنا قائمة (في العامود الاول ) لمجموعة اسماء لاشخاص ممكن ان تكون مكررة
المطلوب اختيار عدد معين منها (تختاره بنفسك) ودون تكرار بطريقة عشوائية
CODE

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


أثارت هذه المشاركة إعجاب: السعيد الجزائري،



look/images/icons/i1.gif اختيار عشوائي
  25-03-2019 01:54 مساءً   [1]
معلومات الكاتب ▼
تاريخ الإنضمام : 20-11-2017
رقم العضوية : 1757
المشاركات : 1765
الدولة : مصر
الجنس :
الدعوات : 2
قوة السمعة : 9685
الاعجاب : 25
أحسنت استاذ سليم عمل ممتاز بارك الله فيك



توقيع :ali mohamed ali


{ وَقُل رَّبِّ زِدْنِي عِلْمًا }
[ كن على يقين من اعمالنا نخطئ ومن اخطائنا نتعلم ولذلك لا شي مستحيل ]
ساهم دائماً فى حل أى مشكلة او أستفسار لديك مع إضافة رد بشكره
أو دعوة لمن قدم اليك المساعدة,فالجميع هنا يعمل على مساعدة
الاخرين لوجه الله وان تحتسب له اجر عند الله

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




اضافة رد جديد اضافة موضوع جديد



المواضيع المتشابهه
عنوان الموضوع الكاتب الردود الزوار آخر رد
تعديل كود اخفاء صفوف معينة بمجرد اختيار من قائمة منسدلة هانى على
5 677 hassona229
اختيار عمود معين ashraf_hertlion
3 1208 YasserKhalil
تنشيط خليه اخرى عند الاختيار من القائمة المنسدلة في العمود المحدد ابو طيبه
3 1001 YasserKhalil
اختصار كود لاختيار الشهر أباالحسن
4 1012 أباالحسن
كود لترحيل المدين والدائن وتقرير استدعاء بيانات عن طريق اختيار بيانات التقريروتاريخ فترة zahraamohamed
11 1318 سعد عابد

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









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

الساعة الآن 03:36 PM