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

[gmax]

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

[kapetang]

Καλησπέρα

Γιώργο, τα δεδομένα αποθηκεύονται στον πίνακα «Πίνακα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

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

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

[gmax]

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

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

[kapetang]

Καλησπέρα

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

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

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

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

[kapetang]

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

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

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

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

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

[gmax]

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

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