Μετάβαση στο κύριο περιεχόμενο

Πώς να καταγράφετε αυτόματα την ημερομηνία και την ώρα όταν αλλάζει το κελί;

Είναι εύκολο για εμάς να εισάγουμε στατική ημερομηνία και ώρα χειροκίνητα ή να εισάγουμε μια δυναμική ημερομηνία που αλλάζει με την ώρα του συστήματος με έναν τύπο. Εάν θέλετε να καταγράψετε την ημερομηνία και την ώρα αυτόματα όταν αλλάζετε ή εισάγετε τιμές, αυτό το πρόβλημα μπορεί να είναι κάπως διαφορετικό για να αντιμετωπιστεί. Ωστόσο, σε αυτό το άρθρο, μπορείτε να επιλύσετε αυτήν την εργασία με τα ακόλουθα βήματα.

Καταγράψτε αυτόματα την ημερομηνία και την ώρα όταν το κελί αλλάζει με τον κωδικό VBA


βέλος μπλε δεξιά φούσκα Καταγράψτε αυτόματα την ημερομηνία και την ώρα όταν το κελί αλλάζει με τον κωδικό VBA

Για παράδειγμα, έχω ένα εύρος τιμών και τώρα, όταν αλλάζω ή πληκτρολογώ νέες τιμές στη στήλη B, θέλω να καταγράφει αυτόματα την τρέχουσα ημερομηνία και ώρα στη στήλη C, όπως φαίνεται στο παρακάτω στιγμιότυπο οθόνης:

doc-ενημέρωση-χρόνος-τιμή-αλλαγές-1

Μπορείτε να ολοκληρώσετε αυτήν την εργασία ακολουθώντας τον κώδικα VBA. Κάντε το ως εξής:

1. Κρατήστε πατημένο το ALT + F11 για να ανοίξετε το Παράθυρο Microsoft Visual Basic for Applications.

2. Στη συνέχεια, επιλέξτε το χρησιμοποιημένο φύλλο εργασίας σας από τα αριστερά Εξερεύνηση έργου, κάντε διπλό κλικ για να ανοίξετε το Μονάδα μέτρησηςκαι, στη συνέχεια, αντιγράψτε και επικολλήστε τον ακόλουθο κώδικα VBA στην κενή ενότητα:

Κωδικός VBA: Εγγραφή ημερομηνίας και ώρας αυτόματα όταν αλλάζει το κελί

Private Sub Worksheet_Change(ByVal Target As Range)
'Update 20140722
Dim WorkRng As Range
Dim Rng As Range
Dim xOffsetColumn As Integer
Set WorkRng = Intersect(Application.ActiveSheet.Range("B:B"), Target)
xOffsetColumn = 1
If Not WorkRng Is Nothing Then
    Application.EnableEvents = False
    For Each Rng In WorkRng
        If Not VBA.IsEmpty(Rng.Value) Then
            Rng.Offset(0, xOffsetColumn).Value = Now
            Rng.Offset(0, xOffsetColumn).NumberFormat = "dd-mm-yyyy, hh:mm:ss"
        Else
            Rng.Offset(0, xOffsetColumn).ClearContents
        End If
    Next
    Application.EnableEvents = True
End If
End Sub

doc-ενημέρωση-χρόνος-τιμή-αλλαγές-1

3. Στη συνέχεια, αποθηκεύστε και κλείστε αυτόν τον κωδικό για να επιστρέψετε στο φύλλο εργασίας, τώρα όταν αλλάζετε την τιμή κελιού ή πληκτρολογείτε νέα δεδομένα στη στήλη Β, η ημερομηνία και η ώρα θα καταγράφονται αυτόματα στη στήλη Γ.

:

1. Στον παραπάνω κώδικα, μπορείτε να τροποποιήσετε το "ΒΒ"Σε οποιαδήποτε άλλη στήλη που θέλετε να αλλάξετε τις τιμές κελιών σε αυτό το σενάριο: Ορισμός WorkRng = Intersect (Application.ActiveSheet.Range ("B: B"), Target).

2. Με αυτό xOffsetColumn = 1 script, μπορείτε να εισαγάγετε και να ενημερώσετε την ημερομηνία και την ώρα στην πρώτη στήλη δίπλα στη στήλη αλλαγής τιμής, μπορείτε να αλλάξετε τον αριθμό 1 σε άλλους αριθμούς, όπως 2,3,4,5… που σημαίνει ότι η ημερομηνία θα εισαχθεί το δεύτερη, τρίτη, τέταρτη ή πέμπτη στήλη εκτός από τη στήλη των αλλαγμένων τιμών.

3. Όταν διαγράφετε μια τιμή στην τροποποιημένη στήλη, η ημερομηνία και η ώρα θα καταργηθούν επίσης.

Τα καλύτερα εργαλεία παραγωγικότητας γραφείου

Δημοφιλή χαρακτηριστικά: Εύρεση, επισήμανση ή αναγνώριση διπλότυπων   |  Διαγραφή κενών γραμμών   |  Συνδυάστε στήλες ή κελιά χωρίς απώλεια δεδομένων   |   Γύρος χωρίς φόρμουλα ...
Σούπερ Αναζήτηση: VLookup πολλαπλών κριτηρίων    VLookup πολλαπλών τιμών  |   VLookup σε πολλά φύλλα   |   Ασαφής αναζήτηση ....
Σύνθετη αναπτυσσόμενη λίστα: Γρήγορη δημιουργία αναπτυσσόμενης λίστας   |  Εξαρτημένη αναπτυσσόμενη λίστα   |  Πολλαπλή αναπτυσσόμενη λίστα ....
Διαχειριστής στήλης: Προσθέστε έναν συγκεκριμένο αριθμό στηλών  |  Μετακίνηση στηλών  |  Εναλλαγή κατάστασης ορατότητας κρυφών στηλών  |  Συγκρίνετε εύρη και στήλες ...
Επιλεγμένα Χαρακτηριστικά: Εστίαση πλέγματος   |  Προβολή σχεδίου   |   Μεγάλη Formula Bar    Διαχείριση βιβλίου εργασίας & φύλλου   |  Βιβλιοθήκη πόρων (Αυτόματο κείμενο)   |  Επιλογή ημερομηνίας   |  Συνδυάστε φύλλα εργασίας   |  Κρυπτογράφηση/Αποκρυπτογράφηση κελιών    Αποστολή email ανά λίστα   |  Σούπερ φίλτρο   |   Ειδικό φίλτρο (φίλτρο με έντονη γραφή/πλάγια γραφή/διαγραφή...) ...
Κορυφαία 15 σύνολα εργαλείων12 Κείμενο Εργαλεία (Προσθήκη κειμένου, Κατάργηση χαρακτήρων, ...)   |   50 + Διάγραμμα Τύποι (Gantt διάγραμμα, ...)   |   40+ Πρακτικό ΜΑΘΗΜΑΤΙΚΟΙ τυποι (Υπολογίστε την ηλικία με βάση τα γενέθλια, ...)   |   19 Εισαγωγή Εργαλεία (Εισαγωγή κωδικού QR, Εισαγωγή εικόνας από το μονοπάτι, ...)   |   12 Μετατροπή Εργαλεία (Αριθμοί σε λέξεις, Μετατροπή Συναλλάγματος, ...)   |   7 Συγχώνευση & διαχωρισμός Εργαλεία (Σύνθετες σειρές συνδυασμού, Διαίρεση κελιών, ...)   |   ... κι αλλα

Αυξήστε τις δεξιότητές σας στο Excel με τα Kutools για Excel και απολαύστε την αποτελεσματικότητα όπως ποτέ πριν. Το Kutools για Excel προσφέρει πάνω από 300 προηγμένες δυνατότητες για την ενίσχυση της παραγωγικότητας και την εξοικονόμηση χρόνου.  Κάντε κλικ εδώ για να αποκτήσετε τη δυνατότητα που χρειάζεστε περισσότερο...

kte καρτέλα 201905


Το Office Tab φέρνει τη διεπαφή με καρτέλες στο Office και κάνει την εργασία σας πολύ πιο εύκολη

  • Ενεργοποίηση επεξεργασίας και ανάγνωσης καρτελών σε Word, Excel, PowerPoint, Publisher, Access, Visio και Project.
  • Ανοίξτε και δημιουργήστε πολλά έγγραφα σε νέες καρτέλες του ίδιου παραθύρου και όχι σε νέα παράθυρα.
  • Αυξάνει την παραγωγικότητά σας κατά 50% και μειώνει εκατοντάδες κλικ του ποντικιού για εσάς κάθε μέρα!
Comments (109)
No ratings yet. Be the first to rate!
This comment was minimized by the moderator on the site
Hi,
Is it is also possible to have a VBA code that is able to create a timestamp for cells that have a formula in it? So when the value changes (changes from empty cell to a cell with a value >0 in it) the timestamp appears?
Kind regards,
Femke
This comment was minimized by the moderator on the site
Hello, Femke,
To solve your problem, please apply the below VBA code:
Private Sub Worksheet_Change(ByVal Target As Range)
'Updateby ExtendOffice
Dim WorkRng As Range
Dim Rng As Range
Dim xOffsetColumn As Integer
Dim xDRg As Range

On Error Resume Next
Set xDRg = Target.DirectDependents

If Not xDRg Is Nothing Then

Set WorkRng = Intersect(Application.ActiveSheet.Range("B:B"), xDRg)

xOffsetColumn = 1
If Not WorkRng Is Nothing Then
    Application.EnableEvents = False
    For Each Rng In WorkRng
        If Not VBA.IsEmpty(Rng.Value) Then
            Rng.Offset(0, xOffsetColumn).Value = Now
            Rng.Offset(0, xOffsetColumn).NumberFormat = "dd-mm-yyyy, hh:mm:ss"
        Else
            Rng.Offset(0, xOffsetColumn).ClearContents
        End If
    Next
    Application.EnableEvents = True
End If
Else
Set WorkRng = Intersect(Application.ActiveSheet.Range("B:B"), Target)
xOffsetColumn = 1
If Not WorkRng Is Nothing Then
    Application.EnableEvents = False
    For Each Rng In WorkRng
        If Not VBA.IsEmpty(Rng.Value) Then
            Rng.Offset(0, xOffsetColumn).Value = Now
            Rng.Offset(0, xOffsetColumn).NumberFormat = "dd-mm-yyyy, hh:mm:ss"
        Else
            Rng.Offset(0, xOffsetColumn).ClearContents
        End If
    Next
    Application.EnableEvents = True
End If

End If
End Sub


Please have a try, hope it can help you!
This comment was minimized by the moderator on the site
Sir ! I have a problem that I have data entering Column B in sheet 1 and Date Column C in sheet 2....please guide me what will be the code for that...Anyone
This comment was minimized by the moderator on the site
I want to use this code to update multiple cells within the same sheet. How do I write this?For example, when cell C12 changes, C13 gets the datewhen cell C26 changes, C27 gets the date
when cell G13 changes, G14 gets the date
and so on
This comment was minimized by the moderator on the site
datetime    auto_cycle    tool    time_difference
01-01-2021 :10:10:09    1    1    00:00:11
03-01-2021 :10:10:20    1    2    00:00:02
13-10-2021 :10:10:22    1    3    00:00:04
13-10-2021 :10:10:26    1    4    00:00:04
13-10-2021 :10:10:30    1    5    00:00:06
13-10-2021 :10:10:36    1    6    00:00:02
13-10-2021 :10:10:38    1    7    00:00:05
13-10-2021 :10:10:43    1    8    00:00:00
13-10-2021 :10:10:43    1    9    00:00:06
13-10-2021 :10:10:49    1    10    00:00:03
13-10-2021 :10:10:52    1    11    00:00:08
13-10-2021 :10:11:00    1    13    00:00:10
13-10-2021 :10:11:10    1    12    00:00:04
13-10-2021 :10:11:14    1    14    00:00:05
13-10-2021 :10:11:19    1    16    00:00:04
13-10-2021 :10:11:23    1    17    00:00:04
13-10-2021 :10:11:27    1    18    00:00:02
13-10-2021 :10:11:29    1    19    00:00:04
13-10-2021 :10:11:33    1    20    00:00:05
13-10-2021 :10:11:38    1    21    00:00:07
13-10-2021 :10:11:45    1    12    

this is my master file suppose i change the time value in a column corresponding time difference sshould be update in d column automatically without trigger the macro assigning button could you please help me out 
This comment was minimized by the moderator on the site
I see a couple of people asking about formulas and I'm sorry if I missed the answer somewhere in the thread. I am updating very large data sets that then are migrated to hidden sheets. I have those sheets each set with this "latest update" code but since everything on those sheets references back to the larger data set, it does not see a cell update as the formulas remain the same even thought the values change. I need it to update when the value changes and not jus when the content of the cell changes.
This comment was minimized by the moderator on the site
Sir ! Did you find solution of your problem then please share it with me.I am also facing the same issue...I am new in this...Please
This comment was minimized by the moderator on the site
Private Sub Worksheet_Change(ByVal Target As Range)
'Update 20140722
Dim WorkRng As Range
Dim Rng As Range
Dim xOffsetColumn As Integer
Set WorkRng = Intersect(Application.ActiveSheet.Range("A:A"), Target)
xOffsetColumn = 1
If Not WorkRng Is Nothing Then
Application.EnableEvents = False
For Each Rng In WorkRng
If Not VBA.IsEmpty(Rng.Value) Then
Rng.Offset(0, xOffsetColumn).Value = Now
Rng.Offset(0, xOffsetColumn).NumberFormat = "dd-mm-yyyy, hh:mm:ss"
Else
Rng.Offset(0, xOffsetColumn).ClearContents
End If
Next
Application.EnableEvents = True
End If
End Sub

This comment was minimized by the moderator on the site
1 26-02-2021, 11:32:49
1 26-02-2021, 11:32:49
1 26-02-2021, 11:32:49
1 26-02-2021, 11:32:49
1 26-02-2021, 11:32:50
1 26-02-2021, 11:32:50
1 26-02-2021, 11:32:50
1 26-02-2021, 11:32:50
1 26-02-2021, 11:32:50
0 26-02-2021, 11:33:04
0 26-02-2021, 11:33:04
0 26-02-2021, 11:33:04
0 26-02-2021, 11:33:04
0 26-02-2021, 11:33:04
0 26-02-2021, 11:33:04
0 26-02-2021, 11:33:04
0 26-02-2021, 11:33:04
0 26-02-2021, 11:33:04
0 26-02-2021, 11:33:04

Why on 0 value its getting date.. when cell have data then only get date otherwise show balnk...how we can do it vba code
This comment was minimized by the moderator on the site
Hi,The code works perfect but if changed the data in A i was wondering if i could have the date in column B and the time in Column D?Thanks for any help.
This comment was minimized by the moderator on the site
Private Sub Worksheet_Change(ByVal Target As Range)
'Update 20140722
Dim WorkRng As Range
Dim Rng As Range
Dim xOffsetColumn As Integer
Set WorkRng = Intersect(Application.ActiveSheet.Range("J:J"), Target)
xOffsetColumn = 1
If Not WorkRng Is Nothing Then
Application.EnableEvents = False
For Each Rng In WorkRng
If Not VBA.IsEmpty(Rng.Value) Then
Rng.Offset(0, xOffsetColumn).Value = Now
Rng.Offset(0, xOffsetColumn).NumberFormat = "dd-mm-yyyy, hh:mm:ss"
Else
Rng.Offset(0, xOffsetColumn).ClearContents
End If
Next
Application.EnableEvents = True
End If
xOffsetColumn = 2
If Not WorkRng Is Nothing Then
Application.EnableEvents = False
For Each Rng In WorkRng
If Not VBA.IsEmpty(Rng.Value) Then
Rng.Offset(0, xOffsetColumn).Value = Now
Rng.Offset(0, xOffsetColumn).NumberFormat = "hh:mm:ss"
Else
Rng.Offset(0, xOffsetColumn).ClearContents
End If
Next
Application.EnableEvents = True
End If
End Sub
This comment was minimized by the moderator on the site
Hi,If i were to have 2 columns duplicating the same macros, how can that be possible.
I want to show the date and time in column B for values changed in A; while also wanting to show the time and date in column D for values changed in C.
This comment was minimized by the moderator on the site
Hi Extend Office, thank you for guiding me.I am a beginner , i had this problem which i saw some of your faced. This was the situationFor e.g
You want your date and time shown in Column A when any other column of the same row B:AZ for example got their values changed.So heres my solution. Please correct me if the code has any issues. TIA.
Private Sub Worksheet_Change(ByVal Target As Range)

Dim WorkRng As Range
Dim Rng As Range
Dim xOffsetColumn As Integer
Set WorkRng = Intersect(Application.ActiveSheet.Range("B:AZ"), Target)'B:AZ put your own columns'rownumber=Activecell.Row will not work because it it will locate the adjacent row after you press enter or when ur mouse click on other cells
rownumber = Target.Row
If Not WorkRng Is Nothing Then
Application.EnableEvents = False
For Each Rng In WorkRng
If Not VBA.IsEmpty(Rng.Value) Then
Range("A" & rownumber).Value = Now 'gives A and the adjacent row number
Range("A" & rownumber).NumberFormat = "dd-mm-yyyy, hh:mm:ss"
End If
Next
Application.EnableEvents = True
End If
End Sub



Thank you.
There are no comments posted here yet
Load More
Please leave your comments in English
Posting as Guest
×
Rate this post:
0   Characters
Suggested Locations