אופיס 365 אני עושה הגרלה באקסס

[FullTime]

עם הפונקציה הזאת.

Private Sub cmd1_Click()
txt1 = Int(Rnd * 100)
End Sub

ועכשיו,
יש לי טבלה של שמות שלכל אחד יש לו מספר מזהה
אחרי שהוא מגריל אני מסמן את השם כמוגרל.
אני רוצה שהוא לא יגריל שוב את המספר הזה.

יש אפשרות כזאת?

 

[moishy]

ודאי שיש אפשרות כזאת אבל לא עם הקוד הזה.

הנה דרך אחת:

Sub DemoUniqueRandomLongs()
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' DemoUniqueRandomLongs
' This demonstrates the UniqueRandomLongs function.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Dim Res As Variant
    Dim Min As Long
    Dim Max As Long
    Dim N As Long

    '''''''''''''''''''''''''''''
    ' Get 50 non-duplicated Longs
    ' each of which is between
    ' 1 and 200.
    '''''''''''''''''''''''''''''
    Min = 1
    Max = 200
    N = 50

    Res = UniqueRandomLongs(Minimum:=Min, Maximum:=Max, Number:=N)

    If IsArrayAllocated(Res) Then
        For N = LBound(Res) To UBound(Res)
            Debug.Print Res(N)
        Next N
    End If

End Sub

Public Function UniqueRandomLongs(Minimum As Long, Maximum As Long, _
                                  Number As Long, Optional ArrayBase As Long = 1, _
                                  Optional Dummy As Variant) As Variant
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' UniqueRandomLongs
' This returns an array containing elements whose values are between the Minimum and
' Maximum parameters. The number of elements in the result array is specified by the
' Number parameter. For example, you can request an array of 20 Longs between 500 and
' 1000 (inclusive).
' There will be no duplicate values in the result array.
'
' The ArrayBase parameter is used to specify the LBound of the ResultArray. If this
' is omitted, ResultArray is 1-based.
'
' The Dummy argument is to be used only when the function is called from a worksheet.
' Its purpose is to allow you to use the NOW() function as the Dummy parameter to force
' Excel to calculate this function any time a calculation is performed. E.g.,
'       =UniqueRandomLongs(100,199,10,NOW())
' If you don't want to recalulate this function on every calculation, omit the Dummy
' parameter. The Dummy argument serves no other purpose and is not used anywhere
' in the code.
'
' The function returns an array of Longs if successful or NULL if an error occurred
' (invalid input parameter).
'
' Note: The procedure creates its own array of size (Maximum-Minium+1), so very large
' differences between Minimum and Maximum may cause performace issues.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

    Dim SourceArr() As Long
    Dim ResultArr() As Long
    Dim SourceNdx As Long
    Dim ResultNdx As Long
    Dim TopNdx As Long
    Dim Temp As Long

    ''''''''''''''''''''''''''''''''''''''
    ' Test the input parameters to ensure
    ' they are valid.
    ''''''''''''''''''''''''''''''''''''''
    If Minimum > Maximum Then
        UniqueRandomLongs = Null
        Exit Function
    End If
    If Number > (Maximum - Minimum + 1) Then
        UniqueRandomLongs = Null
        Exit Function
    End If
    If Number <= 0 Then
        UniqueRandomLongs = Null
        Exit Function
    End If

    Randomize
    ''''''''''''''''''''''''''''''''''''''''''''''
    ' Redim the arrays.
    ' SourceArr will be sized with an LBound of
    ' Minimum and a UBound of Maximum, and will
    ' contain the integers between Minimum and
    ' Maximum (inclusive). ResultArray gets
    ' a LBound of ArrayBase and a UBound of
    ' (ArrayBase+Number-1)
    ''''''''''''''''''''''''''''''''''''''''''''''
    ReDim SourceArr(Minimum To Maximum)
    ReDim ResultArr(ArrayBase To (ArrayBase + Number - 1))
    ''''''''''''''''''''''''''''''''''''''''''''
    ' Load SourceArr with the integers between
    ' Minimum and Maximum (inclusive).
    ''''''''''''''''''''''''''''''''''''''''''''
    For SourceNdx = Minimum To Maximum
        SourceArr(SourceNdx) = SourceNdx
    Next SourceNdx

    ''''''''''''''''''''''''''''''''''''''''''''''
    ' TopNdx is the upper limit of the SourceArr
    ' from which the Longs will be selected. It
    ' is initialized to UBound(SourceArr), and
    ' decremented in each iteration of the loop.
    ' Selections from SourceArr are always in the
    ' region including and to the left of TopNdx.
    ' The region above (to the right of) TopNdx
    ' is where the used numbers are stored and
    ' no selection is made from that region of
    ' the array.
    ''''''''''''''''''''''''''''''''''''''''''''''
    TopNdx = UBound(SourceArr)
    For ResultNdx = LBound(ResultArr) To UBound(ResultArr)
        ''''''''''''''''''''''''''''''''''''''''''''''''''
        ' Set SourceNdx to a random number between 1 and
        ' TopNdx. ResultArr(ResultNdx) will get its value from
        ' SourceArr(SourceNdx). Only elements of SourceArr
        ' in the region of the array below (to the left of)
        ' TopNdx (inclusive) will be selected for inclusion
        ' in ResultArr. This ensures that the elements in
        ' ResultArr are not duplicated.
        ''''''''''''''''''''''''''''''''''''''''''''''''''
        SourceNdx = Int((TopNdx - Minimum + 1) * Rnd + Minimum)
        ResultArr(ResultNdx) = SourceArr(SourceNdx)
        '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        ' Now, swap elements SourceNdx and TopNdx of SourceArr,
        ' moving the value in SourceArr(SourceNdx) to the region
        ' of SourceArr that is above TopNdx.  Since only elements
        ' of SourceArr in the region below TopNdx (inclusive) are
        ' possible candidates for inclusion in ResultArr, used
        ' values are placed at TopNdx to ensure no duplicates.
        '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        Temp = SourceArr(SourceNdx)
        SourceArr(SourceNdx) = SourceArr(TopNdx)
        SourceArr(TopNdx) = Temp
        '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        ' Decrment TopNdx. This moves the effective UBound of SourceArr
        ' downwards (to the left), thus removing used numbers from the
        ' possibility of inclusion in ResultArr. This ensures we have
        ' no duplicates in the ResultArr.
        '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        TopNdx = TopNdx - 1
    Next ResultNdx

    ''''''''''''''''''''''''''''''
    ' Return the result array.
    ''''''''''''''''''''''''''''''
    UniqueRandomLongs = ResultArr

End Function

Function IsArrayAllocated(V As Variant) As Boolean
''''''''''''''''''''''''''''''''''''''''''
' Ensure we have an allocated array.
''''''''''''''''''''''''''''''''''''''''''
    On Error Resume Next
    IsArrayAllocated = Not (IsError(LBound(V)) And IsArray(V)) And (LBound(V) <= UBound(V))
End Function

כמובן שיש להתאים את שלושת השורות האלו לצרכיך:

    Min = 1 ' המספר הראשון שאפשר להגריל
    Max = 200 ' המספר האחרון שאפשר להגריל
    N = 50 ' כמות המספרים להגריל

הפעלת DemoUniqueRandomLongs תחזיר מספרים אקראיים ולא חוזרים, כפי שהגדרת.

 

[moishy]

והנה שתי פונקציות שיחזירו מערך המכיל את המספרים המוגרלים:

Function RandLotto(Bottom As Integer, Top As Integer, Amount As Integer) As String

Dim iArr As Variant
Dim i As Integer
Dim r As Integer
Dim Temp As Integer

ReDim iArr(Bottom To Top)

For i = Bottom To Top
iArr(i) = i
Next i

For i = Top To Bottom + 1 Step -1
r = Int(Rnd() * (i - Bottom + 1)) + Bottom
Temp = iArr(r)
iArr(r) = iArr(i)
iArr(i) = Temp
Next i

For i = Bottom To Bottom + Amount - 1
RandLotto = RandLotto & " " & iArr(i)
Next i

RandLotto = Trim(RandLotto)

End Function

Public Function RandLotto2(Bottom As Integer, Top As Integer, _
Amount As Integer) As String

Dim iArr As Variant
Dim i As Integer
Dim j As Integer
Dim r As Integer
Dim Temp As Integer

ReDim iArr(Bottom To Top)
For i = Bottom To Top
iArr(i) = i
Next i

For i = Top To Bottom + 1 Step -1
Randomize
r = Int(Rnd() * (i - Bottom + 1)) + Bottom
Temp = iArr(r)
iArr(r) = iArr(i)
iArr(i) = Temp
Next i

For i = Bottom To Amount
For j = i + 1 To Amount
If iArr(i) > iArr(j) Then
Temp = iArr(i)
iArr(i) = iArr(j)
iArr(j) = Temp
End If
Next j
Next i

For i = Bottom To Bottom + Amount - 1
RandLotto2 = RandLotto2 & " " & iArr(i)
Next i

RandLotto2 = Trim(RandLotto2)

End Function

 

[FullTime]

אני לא מבין איך אני עובד איתו.
כמו"כ אני לא רוצה שהוא יגריל לי את כולם במכה אחת.
אני רוצה לעשות לחצן ושיגריל לי כל פעם 2 שמות מתוך הטבלה.

תודה רבה

 

[moishy]

מקוה שתבין לבד כי כעת אין לי כח להסביר.

 

[FullTime]

עובד מצויין.

תודה רבה לך על ההשקעה.