محمود الحربي قام بنشر يونيو 9, 2017 مشاركة قام بنشر يونيو 9, 2017 السلام عليكم ورحمة الله وبركاته ارجو من الاخوان في المنتدى الكريم المساعدة في عدم تكرار الأرقام الملف مرفق لكم في التفاصيل شاكر ومقدر لكم المصنف1.rar رابط هذا التعليق شارك More sharing options...
سليم حاصبيا قام بنشر يونيو 9, 2017 مشاركة قام بنشر يونيو 9, 2017 جرب هذا الماكرو الملف مرفق Option Explicit Sub Tirage_Aleatoire_N_Valeurs_Dans_Liste() Dim SL, ar, i, NB, Lr, k With Application .ScreenUpdating = False .Calculation = xlCalculationManual End With NB = 15 ' ' العدد المطلوب ناقص 1 Lr = 34 For k = 1 To 11 Step 2 ar = Range("A2:a" & Lr) If Not IsNumeric(NB) Or NB > Lr Or NB < 0 Then NB = Lr - 1 Set SL = CreateObject("System.Collections.SortedList") Randomize For i = 1 To NB If Not SL.containsvalue(ar(i, 1)) Then SL.Add Rnd, ar(i, 1) Next i With ActiveSheet For i = 0 To Application.Min(SL.Count - 1, NB) - 1 .Cells(i + 39, k).Value = SL.GetByIndex(i) Next End With Next With Application .ScreenUpdating = True .Calculation = xlCalculationAutomatic End With End Sub المصنف1 Salim.rar 1 رابط هذا التعليق شارك More sharing options...
ياسر خليل أبو البراء قام بنشر يونيو 9, 2017 مشاركة قام بنشر يونيو 9, 2017 بارك الله فيك أخي الغالي سليم وجزيت خيراً على هذا الكود المميز والرائع جربت الكود ووجدت النتائج قد تكون غير دقيقة ويمكن حدوث تكرار .. لذا أضفت شرط في سطر الشرط وإليك التعديل التالي Sub RandomListsSALIM() Dim SL As Object Dim ar As Variant Dim Lr As Long Dim k As Long Dim i As Long Dim nb As Long With Application .ScreenUpdating = False .Calculation = xlCalculationManual End With nb = 16 'Required Plus One +1 Lr = 34 For k = 1 To 11 Step 2 ar = Range("A1:A" & Lr) If Not IsNumeric(nb) Or nb > Lr Or nb < 0 Then nb = Lr - 1 Set SL = CreateObject("System.Collections.SortedList") Randomize For i = 1 To nb If Not SL.containsvalue(ar(i, 1)) And Cells(38, k) <> ar(i, 1) Then SL.Add Rnd, ar(i, 1) Next i For i = 0 To nb - 3 Cells(i + 39, k).Value = SL.GetByIndex(i) Next i Next k With Application .ScreenUpdating = True .Calculation = xlCalculationAutomatic End With End Sub 1 رابط هذا التعليق شارك More sharing options...
سليم حاصبيا قام بنشر يونيو 9, 2017 مشاركة قام بنشر يونيو 9, 2017 6 ساعات مضت, ياسر خليل أبو البراء said: بارك الله فيك أخي الغالي سليم وجزيت خيراً على هذا الكود المميز والرائع جربت الكود ووجدت النتائج قد تكون غير دقيقة ويمكن حدوث تكرار .. لذا أضفت شرط في سطر الشرط وإليك التعديل التالي Sub RandomListsSALIM() Dim SL As Object Dim ar As Variant Dim Lr As Long Dim k As Long Dim i As Long Dim nb As Long With Application .ScreenUpdating = False .Calculation = xlCalculationManual End With nb = 16 'Required Plus One +1 Lr = 34 For k = 1 To 11 Step 2 ar = Range("A1:A" & Lr) If Not IsNumeric(nb) Or nb > Lr Or nb < 0 Then nb = Lr - 1 Set SL = CreateObject("System.Collections.SortedList") Randomize For i = 1 To nb If Not SL.containsvalue(ar(i, 1)) And Cells(38, k) <> ar(i, 1) Then SL.Add Rnd, ar(i, 1) Next i For i = 0 To nb - 3 Cells(i + 39, k).Value = SL.GetByIndex(i) Next i Next k With Application .ScreenUpdating = True .Calculation = xlCalculationAutomatic End With End Sub باركالله بك اخي ياسر و انا بدوري اقترح هذا الكود ربما يكون اسرع قليلاً Option Explicit Option Base 1 Sub Rand() Dim r, c, i, k As Integer For k = 1 To 11 Step 2 Dim g(34) Do c = Application.RandBetween(1, 34) If Not g(c) Then r = r + 1 Cells(i + 39, k) = c: Cells(i + 39, k + 1) = Range("b" & c) i = i + 1 g(c) = True End If Loop Until r = 14 r = 0: i = 0 Erase g Next End Sub 1 رابط هذا التعليق شارك More sharing options...
ياسر خليل أبو البراء قام بنشر يونيو 9, 2017 مشاركة قام بنشر يونيو 9, 2017 جزاك الله خيراً أخي الحبيب سليم الكود الثاني أفضل وأسرع .. بارك الله فيك وكل عام وأنت بخير رابط هذا التعليق شارك More sharing options...
محمود الحربي قام بنشر يونيو 10, 2017 الكاتب مشاركة قام بنشر يونيو 10, 2017 لا تعمل الرجاء ارفاق ملف رحم الله والدينكم رابط هذا التعليق شارك More sharing options...
محمود الحربي قام بنشر يونيو 10, 2017 الكاتب مشاركة قام بنشر يونيو 10, 2017 يوجد تكرار الفكرة العامة للملف حتي توضح الصورة انا اريد اختار رئيس لكل مجموعة من ضمن المجموعة ويتم التوزيع عشوائي للبقية على المجموعات تزيد المجموعات وتنقص بشرط عدم تكرار الأشخاص وجميع الاكواد هذا تكرر الافراد في كل مجموعة 1212.rar رابط هذا التعليق شارك More sharing options...
محمود الحربي قام بنشر يونيو 10, 2017 الكاتب مشاركة قام بنشر يونيو 10, 2017 كيف احط شرط لهذا الدالة عدم تكرار من الارقام RANDBETWEEN($G$1;$G$7)= رابط هذا التعليق شارك More sharing options...
ياسر خليل أبو البراء قام بنشر يونيو 10, 2017 مشاركة قام بنشر يونيو 10, 2017 ما هو عدد أفراد كل مجموعة وكيف ستتم عملية التوزيع ؟ أقصد كيف يتم تحديد عدد أفراد كل مجموعة .. وما هو مقصدك بقولك : كل مجموعة تزيد أو تنقص ..؟ هل معنى ذلك أن عدد كل مجموعة غير ثابت ...؟ أعتقد الموضوع يحتاج لمزيد من التفاصيل مع إرفاق نموذج مصغر به بعض النتائج المتوقعة .. لتشرح على أساسها رابط هذا التعليق شارك More sharing options...
محمود الحربي قام بنشر يونيو 10, 2017 الكاتب مشاركة قام بنشر يونيو 10, 2017 هذا مثال توضيحي للشكل النهائي الى احتاجة لو قدرتي تساعدني بيض الله وجهك ورفعك الله بعلمك ورحم الله والدينك الشكل النهائي شرح.rar رابط هذا التعليق شارك More sharing options...
ياسر خليل أبو البراء قام بنشر يونيو 10, 2017 مشاركة قام بنشر يونيو 10, 2017 العدد الإجمالي 34 في المثال المرفق ولديك 4 مجموعات كل مجموعة مكونة من 5 .. إذاً العدد سيكون 4 * 5 = 20 ، فما مصير الباقي من العدد الإجمالي 34-20 = 14 المفترض أن تكون الأسماء مختلفة ولا يوجد تشابه .. لاحظ وجود الاسم أحمد في الخلية B2 و B35 أم أن المثال فقط للتوضيح أم هل سيكون هناك تشابه في الاسماء؟ رابط هذا التعليق شارك More sharing options...
محمود الحربي قام بنشر يونيو 10, 2017 الكاتب مشاركة قام بنشر يونيو 10, 2017 الأسماء لا توجد تشابه بها نهائياً بالنسبة للاعداد في يتم توزيعها على المجموعات كاملة بدون نقص الاسماء مثال فقط لان ممكن العدد يصبح اكثر من 60 أو 80 رحم الله وأمك وأبوك رابط هذا التعليق شارك More sharing options...
أفضل إجابة ياسر خليل أبو البراء قام بنشر يونيو 10, 2017 أفضل إجابة مشاركة قام بنشر يونيو 10, 2017 أعتذر عن كثرة الأسئلة أحاول الإمساك بكافة الخيوط لأن الموضوع معقد ومتشعب هل عدد المجموعات ثابت أم أنه متغير ..؟ وبالنسبة لعدد الأسر هل سيتم التوزيع بالتساوي على المجموعات .. لأن 34 / 4 مجموعات سينتج عنه عدد غير صحيح .. معنى ذلك أن هناك مجموعات قد تكون أكبر في العدد من مجموعات أخرى (أحاول التفكير بصوت مرتفع ليشاركنا الأخوة الكرام في الموضوع) رابط هذا التعليق شارك More sharing options...
محمود الحربي قام بنشر يونيو 10, 2017 الكاتب مشاركة قام بنشر يونيو 10, 2017 عدد المجموعات متغير عدد الأسر ليس شرط ارقام متساوية يعني ذلك عدد الأسر والافراد لكل أسرة متغير مع تغير المجموعات بزيادة ونقص رابط هذا التعليق شارك More sharing options...
محمود الحربي قام بنشر يونيو 11, 2017 الكاتب مشاركة قام بنشر يونيو 11, 2017 اقتباس هل عدد المجموعات ثابت أم أنه متغير ..؟ لا عدد المجموعات متغير يزيد وينقص يحسب هل رؤساء المجموعات من الاسر ؟ نعم يتم اختيار رؤساء المجموعات من الاسر اختيار يدوي وليس عشوائي . هل العدد الإجمالي للأسر تحت الرئيس متساوية ؟ لا بس تكون متكافئة يعني تقريب الاعداد رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
من فضلك سجل دخول لتتمكن من التعليق
ستتمكن من اضافه تعليقات بعد التسجيل
سجل دخولك الان