Forum

Forum (https://www.ms-office.gr/forum/)
-   Access - Ερωτήσεις / Απαντήσεις (https://www.ms-office.gr/forum/access-erotiseis-apantiseis/)
-   -   [ Πίνακες ] Ορισμός τυχαίου αριθμού σε πεδίο πίνακα (https://www.ms-office.gr/forum/access-erotiseis-apantiseis/450-orismos-tyxaioy-arithmoi-se-pedio-pinaka.html)

dimitris p 25-02-10 14:52

Ορισμός τυχαίου αριθμού σε πεδίο πίνακα
 
1 Συνημμένο(α)
Καλησπέρα σε όλους ...
Θα ήθελα τη βοήθειά σας σε ένα πρόβλημα που αντιμετωπίζω.
Έχω ένα πίνακα με ονόματα μαθητών και για κάθε όνομα υπάρχει ένα πεδίο όπου θέλω να καταχωρώ ένα τυχαίο αριθμό κλήρωσης μέσω VB αν είναι εφικτό.
Θα πρέπει αυτός ο αριθμός να είναι κυμαίνεται μεταξύ δύο τιμών (μικρότερης και μεγαλύτερης πχ 1 και 20 ή 1 και 12) και θα πρέπει να είναι διαφορετικός για κάθε μαθητή. Θα πρέπει να πω ότι το πλήθος των μαθητών θα είναι πάντα μικρότερο ή ίσο με τη μεγαλύτερη τιμή πχ. το 20 ή το 12.

Επισυνάπτω τη βάση δεδομένων προς διευκόλυνση

Ελπίζω να μη ζητώ πολλά, ευχαριστώ εκ των προτέρων...

editolis 26-02-10 02:18

1 Συνημμένο(α)
Αγαπητε φιλε,

Δες εαν το αρχειο που σου επισυναπτω
ειναι αυτο που ζητας...

dimitris p 26-02-10 09:12

Παράθεση:

Αρχική Δημοσίευση από editolis (Μήνυμα 1876)
Αγαπητε φιλε,

Δες εαν το αρχειο που σου επισυναπτω
ειναι αυτο που ζητας...

Αγαπητέ φίλε editoli (μου επιτρέπεις να σε θεωρώ φίλο και εσένα και όλους όσους ασχολούνται με την Access) ευχαριστώ για την απάντηση και το χρόνο σου.
Δεν είναι ακριβώς αυτό που θέλω για δύο λόγους
1. Δεν θα πρέπει ο αριθμός κλήρωσης να είναι δεκαδικός και
2. Αν τον αριθμό τον κάνουμε ακέραιο τότε υπάχρει περίπτωση να έχουμε τον ίδιο αριθμό δύο φορές.

Είναι σαν να θέλουμε να μοιράσουμε 12 ή 14 ή 20 νούμερα σε μαθητές χωρίς να έχουν τον ίδιο αριθμό δύο μαθητές.

Δεν ξέρω πως μπορεί να γίνει ή αν μπορεί να γίνει.

editolis 26-02-10 10:34

1 Συνημμένο(α)
Μου πηρε λιγο χρονο αλλα νομιζω
οτι ειναι αυτο που ζητας.

Σου επισυναπτω την Βαση Δεδομενων...

Tasos 26-02-10 14:20

Καλημέρα σε όλους!

Αγαπητέ Δημήτρη, καλωσόρισες στην παρέα μας!

Η δημιουργία τυχαίων αριθμών με όριο, επιτυνχάνεται είτε με SQL (βλ. το παράδειγμα του Τόλη), είτε με τη χρήση του αντικειμένου "Scripting.Dictionary" από τη βιβλιοθήκη Scripting Object - "scrrun.dll" (αν χρειαστεί, το βρίσκουμε εδώ: VBE> Tools> References > Microsoft Scripting Runtime).
Το αντικείμενο αυτό δεν επιτρέπει διπλοεγγραφές στους πίνακες (Array) που δημιουργεί. Αυτή ακριβώς την ιδιότητα χρησιμοποιούμε για να δημιουργήσουμε έναν πίνακα με μοναδικές τυχαίες τιμές που κατόπιν θα περαστούν στο κατάλληλο πεδίο στον πίνακα της βάσης.
Από πλευράς απόδοσης, το "Scripting.Dictionary" είναι ταχύτατο.

Δείτε ένα παράδειγμα κώδικα.
Ο κώδικας προϋποθέτει ένα πεδίο με το όνομα "LotNr".

Option Compare Database
Option Explicit

Private Sub cmdRandomize_Click()
Dim i%, RecCount%, fld As DAO.Field, TheKeys As Variant
With CurrentDb.OpenRecordset(Me.RecordSource, dbOpenDynaset)
If .RecordCount Then .MoveLast: .MoveFirst
RecCount = .RecordCount
Set fld = .Fields("LotNr")
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

Meteora 26-02-10 14:51

Τάσοοοοοοοοοοοοοοοοοοοοοο ! Το Σαββατοκύριακο τι θα κάνουμε ;
Λοιπόν !
Απαγορεύεται να γράφουν στην Access την Παρασκευή - Σάββατο - Κυριακή οι παρακάτω : Τόλης, Γιάννης, Κώστας και Τάσος!
Αστειεύομαι. Όλοι περιμένουμε τα γραψίματά τους...
Την Καλημέρα -και απο εδώ - σε όλους σας
Φιλικά / Νίκος

Tasos 26-02-10 16:12

........Αγαπητέ μου θα χρειαστούμε αμέτρητα Σαββατοκύριακα για να καλύψουμε το Θέμα:
Office μέχρι την έκδοση 2007!
Μετά.. πάμε γι άλλα (Office 2010...):plaf:

kon73 26-02-10 17:34

Καλησπέρα,

Παρουσιάζω μια προσωπική μου συνάρτηση παραγωγής τυχαίων αριθμών και παίρνει απλά την Minimum (Ελάχιστη) και Maximum (Μέγιστη) τιμή.

Ενώ αν θέλουμε να την περάσουμε σε SQL ερώτημα αλλάζουμε λίγο την Randomize βάζοντας και το DumField παράμετρο
και η μία στήλη θα είναι οι τυχαίοι αριθμοί πχ η στήλη ας λέγεται (FieldRand) θα βάλουμε στην συνάρτηση και το DumField οπότε έχουμε Πχ για εύρος τυχαίων αριθμών από 10 έως 20 "Select Field1, Field2, Randomize(10,20,[Field1]) as FieldRand From Table1"


Public Function Randomize(Min, Max As Integer) As Integer
Randomize = Int((Max - Min + 1) * Rnd + Min)
End Function

'Για SQL Ερώτημα

Public Function Randomize(Min, Max As Integer, DumField ) As Integer
Randomize = Int((Max - Min + 1) * Rnd + Min)
End Function

dimitris p 26-02-10 19:53

1 Συνημμένο(α)
Παράθεση:

Αρχική Δημοσίευση από editolis (Μήνυμα 1880)
Μου πηρε λιγο χρονο αλλα νομιζω
οτι ειναι αυτο που ζητας.

Σου επισυναπτω την Βαση Δεδομενων...


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

Χίλια ευχαριστώ σε όλους και καλό Σαββατοκύριακο.

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

Tasos 26-02-10 22:33

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

Κώδικας:

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



Η ώρα είναι 04:50.

Ms-Office.gr - ©2000 - 2026, Jelsoft Enterprises Ltd.


Search Engine Optimization by vBSEO 3.3.2