logo

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



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





11-09-2018 09:50 مساءً
معلومات الكاتب ▼
تاريخ الإنضمام : 22-08-2017
رقم العضوية : 43
المشاركات : 853
الجنس :
تاريخ الميلاد : 1-5-1989
الدعوات : 1
قوة السمعة : 6611
الاعجاب : 2
اذا اردنا ان تختار مجموعة عشوائية من تلاميذ صف ( بعدد محدد) و ادراج اسمائهم في عامود (دون تكرار)
و في عامود اخر ما بيقى منهم
اكسل يحل لنا هذا الموضوع بواسطة هذا الملف
الكود
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 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


الملف مرفق
 
 
  Choose_Studiantes.rar   تحميل rar مرات التحميل :(30)
الحجم :(26.311) KB


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



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




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



توقيع :ali mohamed ali


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

look/images/icons/i1.gif كيف نختار مجموعة عشوائية من التلاميذ
  11-09-2018 10:52 مساءً   [3]
معلومات الكاتب ▼
تاريخ الإنضمام : 27-10-2017
رقم العضوية : 1282
المشاركات : 153
الجنس :
تاريخ الميلاد : 0-4-1978
الدعوات : 1
قوة السمعة : 250
الاعجاب : 0
ماشاء الله ... جزاك الله خير 81




look/images/icons/i1.gif كيف نختار مجموعة عشوائية من التلاميذ
  11-09-2018 11:25 مساءً   [4]
معلومات الكاتب ▼
تاريخ الإنضمام : 03-10-2017
رقم العضوية : 852
المشاركات : 1580
الدولة : مصر
الجنس :
تاريخ الميلاد : 1-9-1995
الدعوات : 5
قوة السمعة : 10861
الاعجاب : 6
موقعي : زيارة موقعي
جزاك الله خيرا استاذ سليم 142




look/images/icons/i1.gif كيف نختار مجموعة عشوائية من التلاميذ
  14-09-2018 08:15 مساءً   [5]
معلومات الكاتب ▼
تاريخ الإنضمام : 01-03-2018
رقم العضوية : 4669
المشاركات : 486
الجنس :
الدعوات : 2
قوة السمعة : 1149
الاعجاب : 7
أحسنت استاذ سليم همة مشكورة
بارك الله فيك




look/images/icons/i1.gif كيف نختار مجموعة عشوائية من التلاميذ
  15-09-2018 07:31 صباحاً   [6]
معلومات الكاتب ▼
تاريخ الإنضمام : 15-03-2018
رقم العضوية : 4874
المشاركات : 194
الجنس :
تاريخ الميلاد : 29-5-1982
الدعوات : 1
قوة السمعة : 469
الاعجاب : 0
سلمت يداك جزاك الله خيرا ... ولكن ع ما اعتقد الكود مش بيعطي نتائج مظبوطه عند اختيار عدد 20 او رقم اقل من 16 يعطي بالعود الاولي 19 والثاني 17




look/images/icons/i1.gif كيف نختار مجموعة عشوائية من التلاميذ
  15-09-2018 08:35 صباحاً   [7]
معلومات الكاتب ▼
تاريخ الإنضمام : 22-08-2017
رقم العضوية : 43
المشاركات : 853
الجنس :
تاريخ الميلاد : 1-5-1989
الدعوات : 1
قوة السمعة : 6611
الاعجاب : 2
المشاركة الأصلية كتبت بواسطة: 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
الملف الجديد
 
 
  Choose_Studiantes_New.rar   تحميل rar مرات التحميل :(6)
الحجم :(25.692) KB





look/images/icons/i1.gif كيف نختار مجموعة عشوائية من التلاميذ
  15-09-2018 09:10 صباحاً   [8]
معلومات الكاتب ▼
تاريخ الإنضمام : 15-03-2018
رقم العضوية : 4874
المشاركات : 194
الجنس :
تاريخ الميلاد : 29-5-1982
الدعوات : 1
قوة السمعة : 469
الاعجاب : 0
اشكرك استاذ سليم مجهود رائع واشكر ردك الكريم والكود الرائع سلمت يداك اخي وجزاك الله من فضله




look/images/icons/i1.gif كيف نختار مجموعة عشوائية من التلاميذ
  15-09-2018 09:56 صباحاً   [9]
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 10529
الجنس :
تاريخ الميلاد : 1-10-1978
الدعوات : 24
قوة السمعة : 36757
الاعجاب : 185
جزاك الله خيراً أخي الحبيب سليم ومشكور على الملف الجديد ..
تقبل وافر تقديري واحترامي




look/images/icons/i1.gif كيف نختار مجموعة عشوائية من التلاميذ
  15-09-2018 08:48 مساءً   [10]
معلومات الكاتب ▼
تاريخ الإنضمام : 21-03-2018
رقم العضوية : 5025
المشاركات : 450
الجنس :
تاريخ الميلاد : 19-3-1990
قوة السمعة : 796
الاعجاب : 0
أحسنت استاذى الكريم




look/images/icons/i1.gif كيف نختار مجموعة عشوائية من التلاميذ
  14-03-2019 08:38 مساءً   [11]
معلومات الكاتب ▼
تاريخ الإنضمام : 13-03-2019
رقم العضوية : 11948
المشاركات : 20
الجنس :
تاريخ الميلاد : 9-9-1986
قوة السمعة : 30
الاعجاب : 0
بارك الله فيك




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




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









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

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