Note: The other languages of the website are Google-translated. Back to English
Σύνδεση  \/ 
x
or
x
Εγγραφή  \/ 
x

or

Πώς να προσθέσετε / εισαγάγετε αυτόματα την τρέχουσα ημερομηνία / ώρα σε ένα κελί με διπλό κλικ στο 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. Η τρέχουσα ημερομηνία ή ώρα θα εισαχθεί αυτόματα.

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

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

Το Kutools για Excel λύνει τα περισσότερα από τα προβλήματά σας και αυξάνει την παραγωγικότητά σας κατά 80%

  • Επαναχρησιμοποίηση: Εισαγάγετε γρήγορα σύνθετοι τύποι, γραφήματα και οτιδήποτε έχετε χρησιμοποιήσει στο παρελθόν. Κρυπτογράφηση κυττάρων με κωδικό πρόσβασης Δημιουργία λίστας αλληλογραφίας και στείλτε email ...
  • Super Formula Bar (επεξεργαστείτε εύκολα πολλές γραμμές κειμένου και τύπου). Διάταξη ανάγνωσης (εύκολη ανάγνωση και επεξεργασία μεγάλου αριθμού κελιών). Επικόλληση σε φιλτραρισμένο εύρος...
  • Συγχώνευση κελιών / σειρών / στηλών χωρίς απώλεια δεδομένων · Περιεχόμενο διαχωρισμού κελιών Συνδυάστε διπλές σειρές / στήλες... Αποτροπή διπλών κυττάρων; Συγκρίνετε τα εύρη...
  • Επιλέξτε Διπλότυπο ή Μοναδικό Σειρές; Επιλέξτε Κενές σειρές (όλα τα κελιά είναι κενά). Σούπερ εύρεση και ασαφής εύρεση σε πολλά βιβλία εργασίας. Τυχαία επιλογή ...
  • Ακριβές αντίγραφο Πολλαπλά κελιά χωρίς αλλαγή της αναφοράς τύπου. Αυτόματη δημιουργία αναφορών σε πολλαπλά φύλλα? Εισαγωγή κουκκίδων, Πλαίσια ελέγχου και άλλα ...
  • Εξαγωγή κειμένου, Προσθήκη κειμένου, Κατάργηση κατά θέση, Αφαιρέστε το διάστημα; Δημιουργία και εκτύπωση υποσύνολων σελιδοποίησης. Μετατροπή περιεχομένου και σχολίων μεταξύ κελιών...
  • Σούπερ φίλτρο (αποθηκεύστε και εφαρμόστε σχήματα φίλτρων σε άλλα φύλλα). Προηγμένη ταξινόμηση ανά μήνα / εβδομάδα / ημέρα, συχνότητα και άλλα. Ειδικό φίλτρο με έντονη, πλάγια ...
  • Συνδυάστε βιβλία εργασίας και φύλλα εργασίας; Συγχώνευση πινάκων βάσει βασικών στηλών. Διαχωρίστε τα δεδομένα σε πολλά φύλλα; Μαζική μετατροπή xls, xlsx και PDF...
  • Περισσότερα από 300 ισχυρά χαρακτηριστικά. Υποστηρίζει Office / Excel 2007-2019 και 365. Υποστηρίζει όλες τις γλώσσες. Εύκολη ανάπτυξη στην επιχείρηση ή τον οργανισμό σας. Πλήρεις δυνατότητες δωρεάν δοκιμής 30 ημερών. Εγγύηση επιστροφής χρημάτων 60 ημερών.
kte καρτέλα 201905

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

  • Ενεργοποίηση επεξεργασίας και ανάγνωσης καρτελών σε Word, Excel, PowerPoint, Publisher, Access, Visio και Project.
  • Ανοίξτε και δημιουργήστε πολλά έγγραφα σε νέες καρτέλες του ίδιου παραθύρου και όχι σε νέα παράθυρα.
  • Αυξάνει την παραγωγικότητά σας κατά 50%και μειώνει εκατοντάδες κλικ ποντικιού για εσάς κάθε μέρα!
κάτω μέρος γραφείου
Say something here...
symbols left.
You are guest
or post as a guest, but your post won't be published automatically.
Loading comment... The comment will be refreshed after 00:00.
  • To post as a guest, your comment is unpublished.
    Joe · 1 years ago
    This was just what I was looking for - this save a ton of time and I appreciate the well written instructions. Thank you!

  • To post as a guest, your comment is unpublished.
    Lee Hoemann · 1 years ago
    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.
  • To post as a guest, your comment is unpublished.
    Heather · 2 years ago
    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.
  • To post as a guest, your comment is unpublished.
    Dylan · 2 years ago
    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?
    • To post as a guest, your comment is unpublished.
      Heather · 2 years ago
      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.
    • To post as a guest, your comment is unpublished.
      Heather · 2 years ago
      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.
    • To post as a guest, your comment is unpublished.
      crystal · 2 years ago
      Hi Dylan,
      Sorry can't help you with that yet. Thank you for your comment.
  • To post as a guest, your comment is unpublished.
    Max · 2 years ago
    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.
  • To post as a guest, your comment is unpublished.
    Trav · 3 years ago
    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
    • To post as a guest, your comment is unpublished.
      crystal · 3 years ago
      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
  • To post as a guest, your comment is unpublished.
    Tee · 3 years ago
    Hello, the code you gave works great. I am just curious if there is any way to have the text "double click to add date" In the cell until the date is entered. Thank you in advance ( I am trying to make my document as user friendly as possible as to not confuse my co-workers)
  • To post as a guest, your comment is unpublished.
    Dre · 3 years ago
    I copied and pasted the code updating the range and it did not work :-(


    Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Not Intersect(Target, Range("B4:B100")) Is Nothing Then
    Cancel = True
    Target.Formula = Now()
    End If
    End Sub
    • To post as a guest, your comment is unpublished.
      crystal · 3 years ago
      Good day,
      The code works well in my case. Can you tell me your Office version?
  • To post as a guest, your comment is unpublished.
    Paul · 3 years ago
    The double click entery code created is:


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

    If Not Intersect(Target, Range("b1:b1000")) Is Nothing Then
    Cancel = True
    Target.Formula = Time
    End If

    If Not Intersect(Target, Range("g1:g1000")) Is Nothing Then
    Cancel = True
    Target.Formula = Time
    End If
    End Sub
    • To post as a guest, your comment is unpublished.
      crystal · 3 years ago
      Dear Paul,
      Please try the following VBA code.

      Private Sub Worksheet_Change(ByVal Target As Range)
      Dim xRg As Range
      On Error Resume Next
      Set xRg = Intersect(Range("A1:a1000,b1:b1000,G1:G1000"), Target)
      If xRg Is Nothing Then Exit Sub
      Target.Worksheet.Unprotect Password:="123"
      xRg.Locked = True
      Target.Worksheet.Protect Password:="123"
      End Sub

      Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
      Application.EnableEvents = False
      ActiveSheet.Unprotect Password:="123"
      If Not Intersect(Target, Range("A1:a1000")) Is Nothing Then
      Cancel = True
      Target.Formula = Date
      End If
      If Not Intersect(Target, Range("b1:b1000")) Is Nothing Then
      Cancel = True
      Target.Formula = Time
      End If
      If Not Intersect(Target, Range("g1:g1000")) Is Nothing Then
      Cancel = True
      Target.Formula = Time
      End If
      ActiveSheet.Protect Password:="123"
      Application.EnableEvents = True
      End Sub
  • To post as a guest, your comment is unpublished.
    Paul · 3 years ago
    The code really works... Thank you...i have added another code to protect the cell after the entry of data. Now the problem is that, once i enter the data and the cell is protected and by mistake if I double click the protected cell, then the above code goes wrong for the whole sheet. It does not work then. I have to unprotect the sheet to bring the code live. Any solution?

    The protection Code used is below:

    Private Sub Worksheet_Change(ByVal Target As Range)
    Dim xRg As Range
    On Error Resume Next
    Set xRg = Intersect(Range("A1:a1000,b1:b1000,G1:G1000"), Target)
    If xRg Is Nothing Then Exit Sub
    Target.Worksheet.Unprotect Password:="123"
    xRg.Locked = True
    Target.Worksheet.Protect Password:="123"
    End Sub
    • To post as a guest, your comment is unpublished.
      crystal · 3 years ago
      Sorry I get your point. (miss the above code)
    • To post as a guest, your comment is unpublished.
      crystal · 3 years ago
      Dear Paul,
      I try the code you provided. The entire worksheet will be protected immediately once I enter data into any one of the specified protected cells.
      Besides, when double click on the protected cell, nothing changes to the code in my case.
      Would you explain what you are exactly trying to do with the code?
  • To post as a guest, your comment is unpublished.
    Joel · 4 years ago
    How do we extend this to add more cell range? I added a these extra cell ranged to the code : (Target, Range("C10:C19", "D10:D19", "E10:E19")) however it is giving me a compile error saying "wrong number of arguments or invalid property assignments" and then it highlights the first line of code you supplied "Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)" Please assist me.
    • To post as a guest, your comment is unpublished.
      Nick · 4 years ago
      Joel, don't know if you are still looking for a solution, but you need to change your code:

      From: (Target, Range("C10:C19", "D10:D19", "E10:E19"))
      To: (Target, Range("C10:C19,D10:D19,E10:E19"))

      This will do it for you.
      • To post as a guest, your comment is unpublished.
        Attila · 3 years ago
        Hello Nick,
        I'd like to get some advise from you on this subject....
        I have a file that I call "productivity sheet".... On this sheet I'd like to insert the actual time,in selected cells, when the cell is clicked... (If possible, I'd like these cells after the time appears to become unchangeable .....something like to be locked.)
        I do appreciate your time and thanx in advance
        Attila, Hungary
        exyzee@gmail.com
        • To post as a guest, your comment is unpublished.
          crystal · 3 years ago
          Dear Attila,
          Please try the below screenshot to insert the actual time to cell in a certian range when it is clicked.
          (The automatically locking cells function can't be acheived, sorry about that)

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