استخدام دالة ( RANDBETWEEN ) بشرط عدم التكرار في عمود

[m_127899]

السلام عليكم ورحمة الله وبركاته

كيف يمكن استخدام دالة ( RANDBETWEEN ) في عمود يتكون من ( 14 صف ) بشرط عدم تكرار القيم من ( 1 - 14 ) في نفس العمود

[أحمد يوسف]

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

الملف من أعمال استاذنا الكبير سليم حاصبيا

Rand_Bet.xlsm

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

استاذ أحمد

حفاظاً على حق الملكية الفكرية كان يجب ذكر صاحب الملف  (و أنا متاكد ان هذا  سقط منك سهواً)

   و بالمناسبة تعديل بسيط على الكود حتى لا تظهر أحطاء في جال قام المستخدم بكتابة نصوص او ارقام سالبة

Option Explicit

Sub rand_num()
If ActiveSheet.Name <> "ورقة1" Then Exit Sub
Dim i%
If Val([f2]) <= 0 Then [f2] = 1
If Val([g2]) <= 0 Then [g2] = 10

[f2] = Int([f2]): [g2] = Int([g2])
Dim myStart%: myStart = Application.Min([f2], [g2])
Dim myEnd%: myEnd = Application.Max([f2], [g2])
Dim a()

Range("C2", Range("C1").End(4)).ClearContents
ReDim a(myEnd - myStart)
 With CreateObject("System.Collections.SortedList")
    Randomize
      For i = myStart To myEnd
       .Item(Rnd) = i
       Next i
      
      For i = 0 To .Count - 1
      a(i) = .GetByIndex(i)
      Next
  End With
  Range("C2").Resize(UBound(a) + 1).Value = Application.Transpose(a)
  Erase a
End Sub

 

[m_127899]

جزاااااااااااااااااااااااااااااااكم الله خير أحبتي وبارك الله فيكم ....ابداع

ولكن هل يمكن استبدال الكودات بمعاملات اكسل المتوفرة ؟؟

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

هذا ماكرو اخر يدرج لك ارقاماً عشوائية بين 1 و اي رقم تختارة في الخلية D2

اذا كانت الخلية  D2 فارغة  او أقل  من صفر يتم اختيار الارقام بين 1 و 10 

Option Explicit
Sub Rand()
   Dim HowMany As Long
   Dim X As Long, Y As Long
   Dim Tmp() As Long
   Dim Arr() As Long
   
   HowMany = [D2]
      If Val(HowMany) <= 0 Then _
      HowMany = 10: [D2] = HowMany
   ReDim Arr(1 To HowMany)
   ReDim Tmp(1 To HowMany)
    
    For X = 1 To HowMany
     Arr(X) = X
    Next
   
  For X = UBound(Arr) To LBound(Arr) Step -1
    Y = Int((X - LBound(Arr) + 1) * Rnd + LBound(Arr))
    Tmp(X) = Arr(Y)
    Arr(Y) = Arr(X)
    Arr(X) = Tmp(X)
  Next
  
    With Cells(1, "A").CurrentRegion.Columns(1)
      .ClearContents
       Cells(1).Resize(UBound(Arr)) = _
       Application.Transpose(Arr)
    End With
Erase Arr: Erase Tmp

  
End Sub

 

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

الصديق m_127

يمكن عمل ذلك بالمعادلات لكن هناك مشكلة انه تتغير الأرقام كلما غيرت حلية او عدة خلايا في الشبت (لأن المعادلة تعتمد على Randbetween )

اليك هذا المثال

كل ما عليك كتابة الـــ  Min  و الــ Max

المعادلات محمية (دون باسبرورد) لعدم العبث بها عن طريق الخطأ

اذا اردت نسخها او التعديل عليها فقط ارفع الحماية عن الشيت

 

Rand_By_Formula.xlsx

[m_127899]

أخي المبدع سليم سلمت أيديك الذهبية