Forum

Forum (https://www.ms-office.gr/forum/)
-   Excel - Ερωτήσεις / Απαντήσεις (https://www.ms-office.gr/forum/excel-erotiseis-apantiseis/)
-   -   [Συναρτήσεις] Χρονόμετρο στην Excel (https://www.ms-office.gr/forum/excel-erotiseis-apantiseis/1062-xronometro-stin-excel.html)

manolis 02-04-11 15:46

Χρονόμετρο στην Excel
 
Καλησπέρα σε όλη την παρέα.

Φτιάχνω ένα αρχείο για να κάνω κάποιες χρονομετρήσεις.
Χρησιμοποιω την NOW σε κάποια κελιά . Αυτή όμως δείχνει την τρέχουσα ώρα. πχ 1:00:00
Θα ήθελα αν γίνεται να φαίνεται ο χρόνος που κυλάει δηλαδή 1:00:00 , 1:00:01 , 1:00:02 κλπ

Επειδή το PC που θα δουλέψει το αρχείο εχει το 2003 αν είναι δυνατον η απάντηση να είναι για 2003

Σας ευχαριστώ

manolis 02-04-11 20:59

Παράθεση:

Αρχική Δημοσίευση από manolis (Μήνυμα 5886)
Καλησπέρα σε όλη την παρέα.

Φτιάχνω ένα αρχείο για να κάνω κάποιες χρονομετρήσεις.
Χρησιμοποιω την NOW σε κάποια κελιά . Αυτή όμως δείχνει την τρέχουσα ώρα. πχ 1:00:00
Θα ήθελα αν γίνεται να φαίνεται ο χρόνος που κυλάει δηλαδή 1:00:00 , 1:00:01 , 1:00:02 κλπ

Επειδή το PC που θα δουλέψει το αρχείο εχει το 2003 αν είναι δυνατον η απάντηση να είναι για 2003

Σας ευχαριστώ

Ψάχνοντας στον θειο γκογκλη :011: βρήκα αυτον τον κώδικα με τον οποίο ξεκινάει το ρολοι.

Αλλα δεν βρίσκω πως να το σταματήσω :wall:

Private Sub Workbook_Open()
If Range("A1").Value = "" Then
Range("A2").Value = Time
Range("A2").Interior.ColorIndex = xlNone
Columns("A:A").AutoFit
Reset_Clock
End If
End Sub
Sub Reset_Clock()
Application.OnTime Now() + TimeValue("00:00:01"), "Update_Clock"
End Sub

Sub Update_Clock()
If Range("A2").Interior.ColorIndex = 36 Then
Exit Sub
End If
Range("A2").Value = Range("A2").Value + 1 / 86400
Reset_Clock
End Sub

Tasos 03-04-11 00:55

Καλημέρα Μανώλη!

Δοκίμασε Το παρακάτω:
Κώδικας:

Option Explicit

Dim ScheduledTime As Date
Const ScheduledJob As String = "UpdateScreen"

Sub StartTimer()
    ScheduledTime = Now + TimeSerial(0, 0, 1)
    Application.OnTime EarliestTime:=ScheduledTime, _
                      Procedure:=ScheduledJob
End Sub

Sub PauseTimer()
    On Error Resume Next
    Application.OnTime EarliestTime:=ScheduledTime, _
                      Procedure:=ScheduledJob, Schedule:=False
End Sub

Sub ResetTimer()
    PauseTimer
  Sheet1.Range("F1") = TimeSerial(0, 0, 0)
End Sub

Sub UpdateScreen()
    With Sheet1.Range("F1")
        .Value = .Value + TimeSerial(0, 0, 1)
    End With
    StartTimer
End Sub

Φιλικά

Τάσος

ΤΖΙΜΗΣ 03-04-11 12:00

Τάσο δοκίμασα τον κώδικα και κάθε διαδικασία την έχω αντιστοιχίσει σε κουμπί εντολής.Ένα για την έναρξη, την παύση κτλ.
Όμως τελικά δεν τρέχει.Κάνω κάποιο λάθος;
Φιλικά Τζίμης.

Tasos 03-04-11 12:34

1 Συνημμένο(α)
Καλησπέρα Τζίμη!

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

Συνημμένο Αρχείο 1361

Φιλικά

Τάσος

manolis 03-04-11 13:04

Γεια σας

Τασο σε ευχαριστώ για τον κώδικα:thumbup1: .
Τον έτρεξα και έχω δύο παρατηρησεις-ερωτησεις

1. Οταν ξεκινάει αρχίζει με 12:00:00 και οχι με την τρέχουσα ώρα.

2. Μπορούμε να το εφαρμόσουμε σε παραπάνω απο 2 κελια ?
Γιατί το προσπάθησα αντιγράφοντας τον κώδικα και αλάζοντας το κελί ,αλλα σταμάτησε το ένα και ξεκίνησε το άλλο


Φιλικά
Μανώλης

ΤΖΙΜΗΣ 03-04-11 13:50

Τάσο ήδη το είχα κάνει αυτό, αλλά τελικά το βρήκα το λάθος.Έπρεπε να εισάγω module και όχι να το εισάγω στο βιβλίο.Τάσο αν μπορείς πες μας λίγα λόγια για την χρησιμότητα της τελευταίας διαδικασίας.(Update Screen) και αν μπορούμε να βάλουμε και ένα όριο, δηλαδή να τερματίζει το ρολόι στα 20 πρώτα λεπτά.
Μανώλη όσο αφορά ότι ξεκινά με 12.00.00 παίζεις με τη μορφοποίηση του κελιού.
Να είστε καλά.

Tasos 03-04-11 14:00

Μανώλη καλησπέρα!

Ο κώδικας ξεκινά να μετρά από το μηδέν αφού μιλάμε για χρονόμετρο.

Το ότι δείχνει 12:00:00 οφείλεται στη μορφοποίηση του κελιού και χρειάζεται
τροποποίηση (ω:λλ:δδ) σε ελληνική μορφή ημερομηνίας.

Δεν είναι σαφές το ζητούμενο σου.

Να ξεκινά από με την τρέχουσα ώρα και να σταματά που;;
Με τον τρόπο αυτό δεν έχεις χρονόμετρο πια αλλά ρολόι!

Το χρονόμετρο ξεκινά από το μηδέν και μετρά το χρόνο από την έναρξη του μέχρι να το σταματήσει ο χρήστης.

Αυτό που ζητάς είναι μάλλον ο χρόνος που μεσολαβεί από το χρονικό σημείο Α μέχρι το
χρονικό σημείο Β.

Δώσε μας τα φώτα σου

Φιλικά

Τάσος

Tasos 03-04-11 14:27

Τζίμη έτσι,

Κώδικας:

Option Explicit

Dim ScheduledTime As Date
Dim EndTime As Date
Const ScheduledJob As String = "UpdateScreen"

Sub StartTimer()
 ' Αν δεν έχει περαστεί τιμή στη μεταβλητή EndTime, (που σημαίνει ότι είναι η πρώτη
'εκτέλεση του StartTimer() ), τότε θα δοθεί η τιμή
Now + TimeSerial(0, 20, 0)
    If EndTime = 0 Then EndTime = TimeSerial(0, 20, 0)
    ScheduledTime = Now + TimeSerial(0, 0, 1)
    Application.OnTime EarliestTime:=ScheduledTime, _
                      Procedure:=ScheduledJob
End Sub

Sub PauseTimer()
    On Error Resume Next
   'EndTime = 0 '??? Αν θέλεις μηδενίζεις το χρονικό όριο
    Application.OnTime EarliestTime:=ScheduledTime, _
                      Procedure:=ScheduledJob, Schedule:=False
End Sub

Sub ResetTimer()
    PauseTimer
    EndTime = 0
    Sheet1.Range("F1") = TimeSerial(0, 0, 0)
End Sub

Sub UpdateScreen()
    With Sheet1.Range("F1")
        .Value = .Value + TimeSerial(0, 0, 1) ' Η τιμή του κελιού + 1 δευτερόλεπτο.
        If .Value < EndTime Then StartTimer
    End With
End Sub

Φιλικά

Τάσος

ΤΖΙΜΗΣ 03-04-11 15:25

Τάσο δε σταματά στο πρώτο εικοσάλεπτο και επιπλέον αν επεξεργάζεσαι κάτι στο φύλλο σταματά ο χρόνος.

Tasos 03-04-11 16:06

Ναι Τζίμη, έχεις δίκιο! Δικό μου το λάθος.

Άλλαξε τη γραμμή:
If EndTime = 0 Then EndTime = Now + TimeSerial(0, 20, 0)

με αυτήν:

If EndTime = 0 Then EndTime = TimeSerial(0, 20, 0)

Καλή συνέχεια!

Τάσος

ΤΖΙΜΗΣ 03-04-11 17:07

Τάσο για μια άλλη φορά ζωγράφισες.Με βοήθησες πολύ για ένα θέμα που έχω δημιουργήσει εδώ και δύο χρόνια.Έχω ένα φύλλο με ερωτήσεις πολλαπλής επιλογής και Σ-Λ. Τώρα με αυτό το τρόπο μπορώ να ορίσω και τον προβλεπόμενο χρόνο που κάποιος πρέπει να τις απαντήσει.Βέβαια όπως και σου έγραψα και προηγουμένως το χρονόμετρο σταματά με κάποια άλλη ενέργεια, πράγμα που σε κάποιον εξεταζόμενο θα του δίνεται επιπλέον χρόνος ή και σε τελική ανάλυση να παγώνει το χρόνο.
Πάντως σε ευχαριστώ θερμά για τις λύσεις που μου δίνεις συνεχώς.

manolis 03-04-11 17:13

1 Συνημμένο(α)
Καλησπέρα

Επισυνάπτω ενα αρχείο με τι ζητάω .
Είναι βέβαια σε 2007 γιατί δεν εχω στο pc που δουλεύω τώρα το 2003.
Αλλα πιστεύω οτι οι μακροεντολές θα δουλέψουν και σε 2003

Οι γραμμές είναι 6 στο τελικό αρχείο.

Ευχαριστώ

Tasos 04-04-11 11:16

1 Συνημμένο(α)
Καλημέρα σε όλους!
Μανώλη δες ένα παράδειγμα στο συνημμένο***:


Καλή συνέχεια!

Τάσος

***Το συνημμένο ενημερώθηκε.

manolis 04-04-11 20:41

Καλησπέρα σε όλη την παρέα

Τάσο σε ευχαριστώ για άλλη μια φορά

Αυτό που έφτιαξες είναι καταπληκτικό :yahoo:

Φιλικά
Μανώλης

ΤΖΙΜΗΣ 05-04-11 13:37

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

Tasos 05-04-11 16:04

Καλησπέρα !
Δεν θα ήταν ότι καλύτερο να συνέβαινε το αντίθετο δηλ. να είχε η μέθοδος OnTime την ύψιστη
προτεραιότητα και να "έπαιρνε το πληκτρολόγιο από τα χέρια του χρήστη".

Κάποιες άλλες διαδικασίες στην Excel που προέρχονται από ενέργειες του χρήστη έχουν την
προτεραιότητα οι οποίες με τη σειρά τους επηρεάζουν την κατάσταση της Εφαρμογής (Ready Mode) οπότε η OnTime οφείλει να περιμένει.

Γενικά η OnTime δεν θα εκτελέσει οτιδήποτε όταν την συγκεκριμένη χρονική στιγμή εκτελείται κάποια άλλη διαδικασία που απασχολεί την εφαρμογή.

Σ αυτή την περίπτωση, η Excel περιμένει μέχρι να τελειώσει η διαδικασία για να επιτρέψει στην OnTime να συνεχίσει.

Αυτό δε σημαίνει ότι το χρονόμετρο μας θα δείξει λάθος αποτελέσματα όταν το σταματήσεις χειροκίνητα.

Σημείωση: Αν έχεις τον κέρσορα μέσα στο κελί να ξέρεις ότι σχεδόν τα πάντα σταματούν στην Excel.
Δες πόσα εργαλεία γκριζάρονται εκείνη τη στιγμή.

Φιλικά

Τάσος






Η ώρα είναι 01:08.

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


Search Engine Optimization by vBSEO 3.3.2