[ Πίνακες ] Ορισμός τυχαίου αριθμού σε πεδίο πίνακα

[Tasos]

Δημήτρη έτσι:

Private Sub Εντολή11_Click()
    Dim i%, RecCount%, fld As DAO.Field, TheKeys As Variant, strSQL$
    strSQL = "Select * From " & Me.RecordSource & IIf(Me.FilterOn, " Where " & Me.Filter, vbNullString)
    With CurrentDb.OpenRecordset(strSQL, dbOpenDynaset)
    
        If .RecordCount Then .MoveLast: .MoveFirst
        RecCount = .RecordCount
        Set fld = .Fields("ΑρΚλήρωσης")
        On Error Resume Next
        With CreateObject("Scripting.Dictionary")
            While .Count < RecCount
                .Add Int((RecCount * Rnd) + 1), 0
            Wend
            TheKeys = .Keys
        End With
        If Err Then Err.Clear: On Error GoTo 0
        For i = 0 To RecCount - 1
            .Edit
            fld = TheKeys(i)
            .Update
            .MoveNext
        Next
        .Close
    End With
    Me.Refresh

End Sub

[kon73]

Να επισημάνω κάτι που είναι αρκετά χρήσιμο σαν τακτική.

Για να περιορίσουμε τις λούπες στους κώδικες που είδα παρακάτω μπορούμε να ορίζουμε κάθε φορά που το Randomize βρίσκει την τιμή Min ή Μax να αλλάζει τα όρια της. Έτσι θα περιορίζονται οι τιμές. πχ Min = 1 Και Max 10 όταν βρεθεί το 1 γίνεται Min=2 έως Max 10. οπότε όταν μείνει η τιμή πχ 8 δεν θα χρειαστεί να έχουμε καμία λούπα καθότι τότε το Min με το Max θα είναι το ίδιο και βάζοντας την συνθήκη if min=max τότε μας δίνει και τον τελευταίο αριθμό άμεσα.

Την αποθήκευση θα την εφάρμοζα με ένα Array με μήκος όσο το Εύρος του Min και Max και απλά έναν έλεγχο αν υπάρχει η τιμή να προσπερνάει και να μην το αποθηκεύει.

Έτσι θα έχουμε Randomize με λιγότερες λούπες και προφανώς με όποιο Min και Max θέλουμε.

[dimitris p]

Αρχική Δημοσίευση από Tasos

Δημήτρη έτσι:

Private Sub Εντολή11_Click()
    Dim i%, RecCount%, fld As DAO.Field, TheKeys As Variant, strSQL$
    strSQL = "Select * From " & Me.RecordSource & IIf(Me.FilterOn, " Where " & Me.Filter, vbNullString)
    With CurrentDb.OpenRecordset(strSQL, dbOpenDynaset)
    
        If .RecordCount Then .MoveLast: .MoveFirst
        RecCount = .RecordCount
        Set fld = .Fields("ΑρΚλήρωσης")
        On Error Resume Next
        With CreateObject("Scripting.Dictionary")
            While .Count < RecCount
                .Add Int((RecCount * Rnd) + 1), 0
            Wend
            TheKeys = .Keys
        End With
        If Err Then Err.Clear: On Error GoTo 0
        For i = 0 To RecCount - 1
            .Edit
            fld = TheKeys(i)
            .Update
            .MoveNext
        Next
        .Close
    End With
    Me.Refresh

End Sub

Ευχαριστώ τους φίλους του forum που έλυσαν το πρόβλημα.
Η λύση που δούλεψε καλύτερα ήταν αυτή του Τάσου.
Θα ήθελα όμως να ευχαριστήσω και τον Τόλη και τον Κωνσταντίνο που ασχολήθηκαν.
Και κάτι τελευταίο.
Στον κώδικα του Τάσου σε ποίο σημείο θα μπορούσαμε να ορίσουμε εμείς την ανώτερη τιμή (Max) που θα παίρνει.

Φιλικά Δημήτρης

[Tasos]

Δημήτρη, η Max στην περίπτωση μας είναι η μεταβλητή "RecCount" .

.....Add Int((RecCount * Rnd) + 1), 0

Βάλε στη θέση της την τιμή που επιθυμείς.

Έδώ να πούμε ότι η συνάρτηση αυτή μπορεί να βελτιωθεί στην απόδοσή της κατά 33% περίπου (το συζητήσαμε με τον Κωνσταντίνο)
δηλαδή σε πλήθος εγγραφών μεγαλύτερο του 50.000 θα έχουμε ένα κέρδος της τάξης των 1 - 2 δευτερολέπτων.

Φιλικά

Τάσος