Εμφάνιση ενός μόνο μηνύματος
  #27  
Παλιά 09-07-10, 20:29
Το avatar του χρήστη nisgia
nisgia Ο χρήστης nisgia δεν είναι συνδεδεμένος
Super Moderator
Όνομα: Γιάννης
Έκδοση λογισμικού Office: Ms-Office 2007
Γλώσσα λογισμικού Office: Ελληνική, Αγγλική
 
Εγγραφή: 12-10-2009
Περιοχή: Ηγουμενίτσα
Μηνύματα: 161
Προεπιλογή

Καλησπέρα στα κομάντα του ms-office!

Μάριε, ασχολήθηκα λίγο με την εφαρμογή σου και θα συμφωνήσω
με τους Γιώργους ότι η ιδέα σου αξίζει συγχαρητήρια!

Την πιο μεγάλη ευθύνη στο θέμα της ταχύτητας πάντως, τη φέρει η έκφραση:
Κώδικας:
...
If pithanotita >= Rnd Then
...
Σκεφτείτε το.
Το μεγαλύτερο ποσοστό του πίνακα ονομάτων είναι αυτό του Γιώργου(0,1221).
Όμως η Rnd() επιστρέφει μια τιμή μεταξύ 0 και 1.
Φανταστείτε λοιπόν πόσες "λούπες" πάνε χαμένες..!

(Δοκίμασα την προσθήκη 10000 ονομάτων και ...μ' έστειλε για τσιγάρο!)

Η λύση σε αυτό είναι να αναγκαστεί η Rnd() κάθε φορά να επιστρέφει
μια τιμή μεταξύ 0 και 0,1221.

Αν έχετε ακόμη όρεξη, αντικαταστήστε την cmdAppendNames_Click() με αυτή:
Κώδικας:
Private Sub cmdAppendNames_Click()
    Dim i As Long
    Dim lngAsked As Long
    Dim strSQL As String
    Dim sngMaxFreq As Single

    i = 0
    lngAsked = CLng(Me.txtNamesCount)

    If lngAsked Then
        With CurrentDb.TableDefs("tblNames").OpenRecordset(4)
            If .RecordCount Then
                DoCmd.Hourglass True
                SysCmd acSysCmdInitMeter, "Append names...", lngAsked
                .MoveLast
                mintCount = .RecordCount
                .FindFirst ("[pososto] < 1")
                sngMaxFreq = !pososto

                strSQL = "INSERT INTO tblRandomOnomata (onoma) SELECT """

                Do While i < lngAsked
                    Randomize
                    .FindFirst ("[onomaID] = " & Int((mintCount * Rnd) + 1))
                    If !pososto >= (Rnd * sngMaxFreq) Then
                        CurrentDb.Execute strSQL & !onoma & """ AS onoma;"
                        i = i + 1
                        SysCmd acSysCmdUpdateMeter, i
                    End If
                Loop
            End If
            DoCmd.Hourglass False
            SysCmd acSysCmdRemoveMeter
        End With
    End If
End Sub
Περιττό να σας πώ πως θα εκπλαγείτε από το αποτέλεσμα όσον αφορά την ταχύτητα
αλλά έχω την εντύπωση πως βελτιώθηκε και λίγο η απόκλιση.

Οφείλω όμως να σου ζητήσω συγγνώμη Μάριε που αφαίρεσα την progress bar.
Το αισθητικό αποτέλεσμα ήταν τέλειο αλλά η progress bar της Access
είναι ταχύτερη και στην ταχύτητα πονάει λίγο η διαδικασία.
(Εδώ που τα λέμε θα μπορούσε να βελτιωθεί πολύ και διαδικασία ενημέρωσης αλλά...)

OffTopic:
Επίσης, να σου ζητήσω συγγνώμη που σε παρεξήγησα πριν αλλά όπως είπες και εσύ
για όλα φταίει ο γραπτός λόγος που στερείται ύφους.
Γιαυτό όμως τα έχουμε τα σκασμένα τα emoticons!
Βάλτε και κανένα και μην φοβάστε, δεν σας τα χρεώνουμε.

Παράθεση:
Αρχική Δημοσίευση από mistirios Εμφάνιση μηνυμάτων
Να ξέρετε επίσης ότι έχω και άλλους πίνακες με πολλά στοιχεία οπότε ετοιμαστείτε!
Μην μένεις στις απειλές Γιώργο! Δώσε πράμα!!!
Δε μασάμε εμείς...!
__________________
Αν δεν το ρωτούσες, δεν θα το μαθαίναμε ποτέ...!
-----------------------------------------------
Τελικά η γνώση, αντίθετα με ό,τι μέχρι σήμερα πίστευα, είναι η φυλακή της σκέψης.
Όταν η αφετηρία είναι η ελεύθερη σκέψη, δεν χρειάζεται πλέον να φτάσεις πουθενά!
Απάντηση με παράθεση