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/1461-anakatema-se-aytomati-apodosi-arithmon.html)

Ανακάτεμα σε αυτόματη απόδοση αριθμών

Γεια σας και πάλι. Ίσως να γίνομαι πολύ φορτικός, αλλά τρώγοντας έρχεται η όρεξη που λένε. Προσάρμοσα όλα όσα μου φτιάξατε, αυτόματη απόδοση αύξοντα αριθμού κ.λ.π., στη φόρμα μου, αλλά μου δημιουργήθηκε μια ακόμη σκέψη για μια ακόμη ευκολία. Μήπως γίνεται μετά την ολοκλήρωση των εγγραφών να γίνεται ένα ανακάτεμα των αριθμών της αυτόματης απόδοσης; Κάτι σαν μια μορφή κλήρωσης; Εδώ να σημειώσω ότι με μια μακροεντολή και ένα κώδικα κάνω ένα μοίρασμα πληρωμάτων σε διαδρομές -μέχρι έξι- και σε σειρές -Α,Β,Γ,κ.λ.π- Δηλαδή αν έχω 15 συμμετοχές αυτές χωρίζονται σε ΣΕΙΡΑ "Α" 6 πληρώματα, ΣΕΙΡΑ "Β" 6 πληρώματα και ΣΕΙΡΑ "Γ" 3 πληρώματα, οι οποίες ορίζονται από τη σειρά εγγραφής. Επειδή πιθανόν να μην είμαι κατανοητός ανεβάζω και τη φόρμα. Και κάτι ακόμα. Πως μπορώ να βάλω σε ένα πίνακα τις τιμές από τα πεδία του πίνακα "Πίνακας1", "Νο1", "ΑΡ ΔΕΛΤΙΟΥ1", "Νο2" και "ΑΡ ΔΕΛΤΙΟΥ2" χωρίς διπλοεγγραφές, ώστε να έχω καταγεγραμμένους όλους τους αθλητές για μελλοντικούς αγώνες;
Ξέρω ότι ζητάω πολλά και επειδή δεν είναι πολύ σημαντικό, τουλάχιστον το πρώτο, αν είναι δύσκολο μην ασχοληθείτε καθόλου. Ευχαριστώ πολύ για τη συνολική βοήθεια που έχω βρει από το φόρουμ.
Με εκτίμηση Γιώργος.

Καλησπέρα

Γιώργο, τα δεδομένα αποθηκεύονται στον πίνακα «Πίνακα1» με τη σειρά καταχώρησης.
Εκεί δεν μπορούμε να αλλάξουμε τη σειρά.
Μπορούμε, όμως να αλλάξουμε τη σειρά εμφάνισης, σε φόρμες, ερωτήματα και εκθέσεις.

Στην επισυναπτόμενη ΒΔ έχω προσθέσει τη φόρμα «ΤΥΧΑΙΑ_ΤΑΞΙΝΟΜΗΣΗ», στην οποία:

1. Πατώντας το κουμπί «Τυχαία ταξινόμηση» μπορούμε να εμφανίσουμε τις εγγραφές με τυχαία σειρά. Αν ξαναπατήσουμε το κουμπί επαναφέρουμε την κανονική ταξινόμηση.

2. Πατώντας το κουμπί «Δημιουργία πίνακα αθλητών» καταχωρούνται τα στοιχεία που θέλεις στον πίνακα «ΑΘΛΗΤΕΣ», που πρόσθεσα στη βάση.
Στην καταχώρηση κάθε συνδυασμός των τιμών των πεδίων[Νο1], [ΑΡ ΔΕΛΤΙΟΥ 1], [Νο2] και [ΑΡ ΔΕΛΤΙΟΥ 2] είναι μοναδικός.

Ο κώδικας που εκτελεί τις παραπάνω λειτουργίες φαίνεται παρακάτω:

Κώδικας:

Private Sub cmdCreateTable_Click()

    Dim strSQL As String

    On Error Resume Next

    strSQL = "INSERT INTO ΑΘΛΗΤΕΣ ( Νο1, [ΑΡ ΔΕΛΤΙΟΥ 1], Νο2, [ΑΡ ΔΕΛΤΙΟΥ 2] ) " & _

    "SELECT DISTINCT Πίνακας1.Νο1, Πίνακας1.[ΑΡ ΔΕΛΤΙΟΥ 1], Πίνακας1.Νο2, " & _

    "Πίνακας1.[ΑΡ ΔΕΛΤΙΟΥ 2]FROM Πίνακας1;"

    CurrentDb.Execute "Delete * From ΑΘΛΗΤΕΣ"

    CurrentDb.Execute strSQL

    On Error GoTo 0

End Sub
 

Private Sub cmdShort_Click()

    If Me.cmdShort.Caption = "Τυχαία ταξινόμηση" Then

        Me.OrderBy = "[fShort]"

        Me.cmdShort.Caption = "Κανονική ταξινόμηση"

    Else

        Me.OrderBy = "[Α/Α]"

        Me.cmdShort.Caption = "Τυχαία ταξινόμηση"

    End If

    Me.OrderByOn = True

End Sub

Ελπίζω να καλύφτηκες.

Φιλικά/Γιώργος

Καλησπέρα σε όλους τους φίλους.
Γιώργο ευχαριστώ που ασχολήθηκες με το ερώτημά μου, αλλά αυτό που ήθελα είναι πολύ πιο πολύπλοκο από μια αλλαγή στη σειρά εμφάνισης. Για την καλύτερη κατανόηση αυτών που ζητάω ανεβάζω έναν πίνακα σε Excel. Όσον αφορά τη δεύτερη ερώτηση, το έλυσα το θέμα με ένα ερώτημα διαγραφής και ένα προσάρτησης, σε έναν πίνακα που δημιούργησα (διαγράφω τις εγγραφές και όχι τον πίνακα, ο οποίος έχει τις ιδιότητες που θέλω,- Με ευρετήριο: Ναι (Δεν επιτρέπονται διπλότυπα))

Με εκτίμηση Γιώργος

Καλησπέρα

Γιώργο, στη συνημμένη ΒΔ προσπάθησα να υλοποιήσω το ζητούμενο.

Πατώντας το κουμπί «Τυχαία σειρά» στη φόρμα «ΤΥΧΑΙΑ_ΚΑΤΑΝΟΜΗ»:

1. Διαγράφονται τα αρχικά δεδομένα του πίνακα «TableRandom», που πρόσθεσα στη βάση.

2. Προσαρτώνται τα δεδομένα του πίνακα «Πίνακα1» στον «TableRandom», αλλά με τους αθλητές σε τυχαία κατανομή στις διαδρομές, σειρές, κλπ.

3. Εμφανίζονται στη φόρμα τα στοιχεία με τυχαία σειρά.
Το ίδιο κουμπί χρησιμοποιείται για να εμφανίσουμε τα στοιχεία και σε κανονική σειρά.

Κάθε φορά που πατάμε το κουμπί «Τυχαία σειρά» δημιουργείται νέα τυχαία κατανομή
Τα παραπάνω υλοποιούνται με τον κώδικα:

Κώδικας:

Private Sub cmdRandom_Click()

    If Me.cmdRandom.Caption = "Τυχαία σειρά" Then

        CreateRandomTable

        Me.RecordSource = "TableRandom"

        Me.cmdRandom.Caption = "Κανονική σειρά"

    Else

        Me.RecordSource = "Πίνακας1"

        Me.cmdRandom.Caption = "Τυχαία σειρά"

    End If

End Sub

Sub CreateRandomTable()

    Dim strSQLStart As String

    Dim rs1 As DAO.Recordset, strSQL As String, rs2 As DAO.Recordset
 

    CurrentDb.Execute "Delete * From TableRandom"

    strSQL = "SELECT Πίνακας1.ΔΙΑΔΡ, Πίνακας1.ΔΙΑΔΡΟΜΗ, Πίνακας1.ΣΕΙΡΑ, " & _

            "Rnd([Α/Α]) as fShort    FROM Πίνακας1 Order by 4 ;"

    Set rs1 = CurrentDb.OpenRecordset(strSQL)
 

    strSQL = "SELECT Πίνακας1.[Α/Α], Πίνακας1.ΑΓΩΝΙΣΜΑ, Πίνακας1.ΚΑΤΗΓΟΡΙΑ, " & _

            " Πίνακας1.ΟΜΙΛΟΣ, Πίνακας1.Νο1, Πίνακας1.[ΑΡ ΔΕΛΤΙΟΥ 1], Πίνακας1.Νο2, " & _

            " Πίνακας1.[ΑΡ ΔΕΛΤΙΟΥ 2], Πίνακας1.ΗΜΕΡΟΜΗΝΙΑ FROM Πίνακας1;"

    Set rs2 = CurrentDb.OpenRecordset(strSQL)
 

    strSQLStart = "Insert Into TableRandom ([Α/Α], [ΑΓΩΝΙΣΜΑ], [ΚΑΤΗΓΟΡΙΑ], [ΟΜΙΛΟΣ], " & _

            "[Νο1], [ΑΡ ΔΕΛΤΙΟΥ 1],[Νο2], [ΑΡ ΔΕΛΤΙΟΥ 2],[ΗΜΕΡΟΜΗΝΙΑ], [ΔΙΑΔΡ], [ΔΙΑΔΡΟΜΗ], [ΣΕΙΡΑ])" & _

            " Values( "

    If rs1.EOF And rs1.BOF Then

        rs1.Close: Set rs1 = Nothing

        rs2.Close: Set rs2 = Nothing

        Exit Sub

    End If

    rs1.MoveFirst: rs2.MoveFirst
 

    Do Until rs1.EOF

        strSQL = strSQLStart & rs2![Α/Α] & ", '" & rs2![ΑΓΩΝΙΣΜΑ] & "', '" & rs2![ΚΑΤΗΓΟΡΙΑ] & "', '" & _

                rs2![ΟΜΙΛΟΣ] & "', '" & rs2![Νο1] & "', " & rs2![ΑΡ ΔΕΛΤΙΟΥ 1] & ", " & _

                IIf(IsNull(rs2![Νο2]), "Null", "'" & rs2![Νο2] & "'") & ", " & _

                IIf(IsNull(rs2![ΑΡ ΔΕΛΤΙΟΥ 2]), "Null", rs2![ΑΡ ΔΕΛΤΙΟΥ 2]) & ", " & _

                "#" & Format(rs2![ΗΜΕΡΟΜΗΝΙΑ], "m/d/yyyy") & "#, " & rs1![ΔΙΑΔΡ] & ", " & _

                rs1![ΔΙΑΔΡΟΜΗ] & ", '" & rs1![ΣΕΙΡΑ] & "' );"

        CurrentDb.Execute strSQL

        rs1.MoveNext: rs2.MoveNext

    Loop

    If Not rs1 Is Nothing Then rs1.Close: Set rs1 = Nothing

    If Not rs2 Is Nothing Then rs2.Close: Set rs2 = Nothing

End Sub

Φιλικά/Γιώργος

Καλησπέρα και πάλι

Η υλοποίηση του ζητούμενου στη συνημμένη ΒΔ είναι παρόμοια μ’ αυτήν που παρουσιάζω στο προηγούμενο μήνυμα.

Είναι όμως καλύτερη:

1. Γιατί αντιμετωπίζει πληρέστερα τα προβλήματα, που μπορεί να δημιουργήσουν οι Null τιμές.

2. Ο κώδικας είναι πιο περιορισμένος και κατανοητός

Κώδικας:

Private Sub cmdRandom_Click()

    Dim strSQL As String

    If Me.cmdRandom.Caption = "Τυχαία σειρά" Then

        CreateRandomTable

        strSQL = "SELECT TableRandom.ΔΙΑΔΡ, TableRandom.ΔΙΑΔΡΟΜΗ, TableRandom.ΣΕΙΡΑ, " & _

        "Πίνακας1.[Α/Α], Πίνακας1.ΚΑΤΗΓΟΡΙΑ, Πίνακας1.ΟΜΙΛΟΣ, Πίνακας1.Νο1, " & _

        "Πίνακας1.[ΑΡ ΔΕΛΤΙΟΥ 1], Πίνακας1.Νο2, Πίνακας1.[ΑΡ ΔΕΛΤΙΟΥ 2], " & _

        "Πίνακας1.ΑΓΩΝΙΣΜΑ, Πίνακας1.ΗΜΕΡΟΜΗΝΙΑ " & _

        "FROM TableRandom INNER JOIN Πίνακας1 ON TableRandom.[Α/Α] = Πίνακας1.[Α/Α];"

        Me.RecordSource = strSQL

        Me.cmdRandom.Caption = "Κανονική σειρά"

    Else

        Me.RecordSource = "Πίνακας1"

        Me.cmdRandom.Caption = "Τυχαία σειρά"

    End If

End Sub

Sub CreateRandomTable()

    Dim strSQLStart As String

    Dim rs1 As DAO.Recordset, strSQL As String, rs2 As DAO.Recordset
 

    CurrentDb.Execute "Delete * From TableRandom"

    strSQL = "SELECT Πίνακας1.ΔΙΑΔΡ, Πίνακας1.ΔΙΑΔΡΟΜΗ, Πίνακας1.ΣΕΙΡΑ, " & _

            "Rnd([Α/Α]) as fShort    FROM Πίνακας1 Order by 4 ;"

    Set rs1 = CurrentDb.OpenRecordset(strSQL)
 

    strSQL = "SELECT Πίνακας1.[Α/Α] FROM Πίνακας1;"

    Set rs2 = CurrentDb.OpenRecordset(strSQL)
 

    strSQLStart = "Insert Into TableRandom ([Α/Α],  [ΔΙΑΔΡ], [ΔΙΑΔΡΟΜΗ], [ΣΕΙΡΑ]) Values( "

    If rs1.EOF And rs1.BOF Then

        rs1.Close: Set rs1 = Nothing: rs2.Close: Set rs2 = Nothing

        Exit Sub

    End If

    rs1.MoveFirst: rs2.MoveFirst
 

    Do Until rs1.EOF

        strSQL = strSQLStart & rs2![Α/Α] & ", " & rs1![ΔΙΑΔΡ] & ", " & _

                rs1![ΔΙΑΔΡΟΜΗ] & ", '" & rs1![ΣΕΙΡΑ] & "' );"

        CurrentDb.Execute strSQL

        rs1.MoveNext: rs2.MoveNext

    Loop

    If Not rs1 Is Nothing Then rs1.Close: Set rs1 = Nothing

    If Not rs2 Is Nothing Then rs2.Close: Set rs2 = Nothing

End Sub

Φιλικά/Γιώργος

Καλησπέρα και για άλλη μια φορά ευχαριστώ. Δουλεύει άψογα.

Με απεριόριστη εκτίμηση, Γιώργος