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

Πώς να προσθέσετε / εισαγάγετε αυτόματα την τρέχουσα ημερομηνία / ώρα σε ένα κελί με διπλό κλικ στο Excel;

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

Κάντε διπλό κλικ για αυτόματη προσθήκη / εισαγωγή τρέχουσας ημερομηνίας ή ώρας ημερομηνίας με τον κωδικό VBA


Κάντε διπλό κλικ για αυτόματη προσθήκη / εισαγωγή τρέχουσας ημερομηνίας ή ώρας ημερομηνίας με τον κωδικό VBA

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

1. Κάντε δεξί κλικ στην καρτέλα Φύλλο που θέλετε να εισαγάγετε την τρέχουσα ημερομηνία στα καθορισμένα κελιά και, στη συνέχεια, επιλέξτε Προβολή κωδικού από το μενού με δεξί κλικ.

2. Στο Microsoft Visual basic για εφαρμογές παράθυρο, αντιγράψτε και επικολλήστε τον παρακάτω κώδικα VBA στο παράθυρο Code.

Κωδικός VBA: Κάντε διπλό κλικ για να προσθέσετε την τρέχουσα ημερομηνία σε ένα κελί

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Not Intersect(Target, Range("A1:B10")) Is Nothing Then
        Cancel = True
        Target.Formula = Date
    End If
End Sub

Notes:

1. Στον κωδικό, A1: B10 είναι το εύρος στο οποίο θα προσθέσετε την τρέχουσα ημερομηνία.
2. Εάν πρέπει να προσθέσετε την τρέχουσα ώρα ημερομηνίας στο κελί, αντικαταστήστε Ημερομηνία με Τώρα() στον κώδικα. Μπορείτε να τα αλλάξετε όπως χρειάζεστε.

3. Τύπος άλλος + Q ταυτόχρονα για να κλείσετε το Microsoft Visual Basic για εφαρμογές παράθυρο και επιστρέψτε στο φύλλο εργασίας.

Από τώρα και στο εξής, όταν κάνετε διπλό κλικ σε οποιοδήποτε κελί στο καθορισμένο εύρος A1: B10. Η τρέχουσα ημερομηνία ή ώρα θα εισαχθεί αυτόματα.


Σχετικά Άρθρα:

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

Δημοφιλή χαρακτηριστικά: Εύρεση, επισήμανση ή αναγνώριση διπλότυπων   |  Διαγραφή κενών γραμμών   |  Συνδυάστε στήλες ή κελιά χωρίς απώλεια δεδομένων   |   Γύρος χωρίς φόρμουλα ...
Σούπερ Αναζήτηση: 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 (29)
No ratings yet. Be the first to rate!
This comment was minimized by the moderator on the site
Holy crap MS get with it! Google sheets can make this happen with a couple of clicks.
This comment was minimized by the moderator on the site
Hi all,

I try to use that macro to use the date stamp double clicking on column E and it's working but when I try to replicate the macro to do the same but for the current time on column F it is not working as you can see attached I have an error message stating : Ambiguous Name Detected.
When I try to change the Sub WorkSheet part for another name and double click in the cells nothing happens.

Could someone help me on that ?

My code :


Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("E1:E10000")) Is Nothing Then
Cancel = True
Target.Formula = Date
End If
End Sub

Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("F1:F10000")) Is Nothing Then
Cancel = True
Target.Formula = Now()
End If
End Sub
This comment was minimized by the moderator on the site
Hi Louis,
Replicate the macro will cause two same procedures with the same name in a single sheet code window. Excel doesn't allow two or more same names of functions in a module. Not even in Events. It leads to ambiguity.
If you want to do a different task on the same event, you need to modify the original code to meet your needs.
The following VBA code can do you a favor. Please give it a try.
Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'Updated by Extendoffice 20221025
    If Not Intersect(Target, Range("E1:E10000")) Is Nothing Then
        Cancel = True
        Target.Formula = Date
    End If
    If Not Intersect(Target, Range("F1:F10000")) Is Nothing Then
        Cancel = True
        Target.Formula = Date
    End If
End Sub
This comment was minimized by the moderator on the site
This function did not work. Double Clicking simply enters manual edit of cell.
This comment was minimized by the moderator on the site
Hi Bob,
The code works well in my case. I need to know more specific about your issue, such as your Excel version.
And the code only works on the cells you specified.
This comment was minimized by the moderator on the site
Hello there, the code did a lot for me, How can I restrict the code to work only if field is blank. If a date is already there in the cell, double click should do nothing, regards
This comment was minimized by the moderator on the site
Hi Ahmad,
Sorry for the trouble. To only fill in the blank cells with dates with double-clicking, you can apply the following VBA code to get it done.
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'Updated by Extendoffice 20220609
    If Not Intersect(Target, Range("B1:C20")) Is Nothing Then
        If Target.Value = "" Then
            Cancel = True
            Target.Formula = Date
        End If
    End If
End Sub
This comment was minimized by the moderator on the site
This was just what I was looking for - this save a ton of time and I appreciate the well written instructions. Thank you!
This comment was minimized by the moderator on the site
So I inserted code and it works great on several sheets in my workbook, however on some sheets it just suddenly stops working after a certain row even though I have the correct range entered. Any thoughts on why this might happen.
This comment was minimized by the moderator on the site
Does anyone know if there is a way to insert this code into Excel Online? I had used it with the desktop version and it worked great but now we have migrated everything to the online platform and my date and time stamps on double click have disappeared and I can't figure out how to view or edit the code. Thanks.
This comment was minimized by the moderator on the site
Love the code and it works great. How can I make it so when I double click to execute the code its shows time in military time?
This comment was minimized by the moderator on the site
I would think that if you just select the Military Time format for that cell from the Number -> Time format options that should do it. For example, you would select 13:30 instead of 1:30 PM, and then it should display in military time.
This comment was minimized by the moderator on the site
I think if you select the military time format for that cell from the Format -> Number -> Time options in your sheet that ought to work. For example, it gives the option of 1:30 PM or 13:30, so you would just select 13:30 and that should do it.
This comment was minimized by the moderator on the site
Hi Dylan,
Sorry can't help you with that yet. Thank you for your comment.
This comment was minimized by the moderator on the site
Hi there,

I copied and pasted the above code exactly as it is written into a blank workbook, however, it does not work for me. I looked at different sources on the web and most sites have a similar format as what is written above. I think perhaps there is something wrong with my VBA or some settings are not turned on. Any advice would be much appreciated. I am running Excel for Office 365 MSO (16.0.11001.20097) 32-bit on Windows 10.
This comment was minimized by the moderator on the site
Hello, the above code worked great for me. Now i am just wondering if there is a way to have the text "Double click to enter date" appear in the cell until the date is entered. My goal is to make the document be as user friendly as possible. Thank you in advance
This comment was minimized by the moderator on the site
Hi Travis,
We can’t modify the code to have text display in the cell directly. But alternatively, the below optimized code will help to display the text in the cell comment, and the comment will be removed automatically after double click the cell to enter date.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("A1:B10")) Is Nothing Then
Target.NoteText "double click to add date"
End If
End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("A1:B10")) Is Nothing Then
Cancel = True
Target.Comment.Delete
Target.Formula = Date
End If
End Sub
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