Note: The other languages of the website are Google-translated. Back to English

Как автоматически добавить / ввести текущую дату / время в ячейку двойным щелчком в Excel?

Если вам нужно часто вставлять текущую дату или дату и время на лист, вы можете попробовать метод, описанный в этой статье. Эта статья поможет вам автоматически добавлять или вводить текущую дату или дату в ячейках указанного диапазона с помощью только двойного щелчка.

Дважды щелкните, чтобы автоматически добавить / ввести текущую дату или дату и время с кодом VBA


Дважды щелкните, чтобы автоматически добавить / ввести текущую дату или дату и время с кодом VBA

Вы можете запустить приведенный ниже код VBA, чтобы автоматически добавить текущую дату или дату и время в ячейку двойным щелчком. Пожалуйста, сделайте следующее.

1. Щелкните правой кнопкой мыши вкладку «Лист», на которой вы хотите вставить текущую дату в указанные ячейки, затем выберите Просмотреть код из контекстного меню.

2. в Microsoft Visual Basic для приложений окна, скопируйте и вставьте приведенный ниже код VBA в окно кода.

Код 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

Заметки:

1. В коде A1: B10 - это диапазон, в который вы добавите текущую дату.
2. Если вам нужно добавить текущую дату и время в ячейку, замените Время с Теперь() в коде. Вы можете изменить их по своему усмотрению.

3. Нажмите другой + Q клавиши одновременно, чтобы закрыть Microsoft Visual Basic для приложений окно и вернитесь к рабочему листу.

С этого момента при двойном щелчке по любой ячейке в указанном диапазоне A1: B10. Текущая дата или дата и время будут введены автоматически.


Статьи по теме:


Лучшие инструменты для работы в офисе

Kutools for Excel решает большинство ваших проблем и увеличивает вашу производительность на 80%

  • Снова использовать: Быстро вставить сложные формулы, диаграммы и все, что вы использовали раньше; Зашифровать ячейки с паролем; Создать список рассылки и отправлять электронные письма ...
  • Бар Супер Формулы (легко редактировать несколько строк текста и формул); Макет для чтения (легко читать и редактировать большое количество ячеек); Вставить в отфильтрованный диапазон...
  • Объединить ячейки / строки / столбцы без потери данных; Разделить содержимое ячеек; Объединить повторяющиеся строки / столбцы... Предотвращение дублирования ячеек; Сравнить диапазоны...
  • Выберите Дубликат или Уникальный Ряды; Выбрать пустые строки (все ячейки пустые); Супер находка и нечеткая находка во многих рабочих тетрадях; Случайный выбор ...
  • Точная копия Несколько ячеек без изменения ссылки на формулу; Автоматическое создание ссылок на несколько листов; Вставить пули, Флажки и многое другое ...
  • Извлечь текст, Добавить текст, Удалить по позиции, Удалить пробел; Создание и печать промежуточных итогов по страницам; Преобразование содержимого ячеек в комментарии...
  • Суперфильтр (сохранять и применять схемы фильтров к другим листам); Расширенная сортировка по месяцам / неделям / дням, периодичности и др .; Специальный фильтр жирным, курсивом ...
  • Комбинируйте книги и рабочие листы; Объединить таблицы на основе ключевых столбцов; Разделить данные на несколько листов; Пакетное преобразование xls, xlsx и PDF...
  • Более 300 мощных функций. Поддерживает Office/Excel 2007-2021 и 365. Поддерживает все языки. Простое развертывание на вашем предприятии или в организации. Полнофункциональная 30-дневная бесплатная пробная версия. 60-дневная гарантия возврата денег.
вкладка kte 201905

Вкладка Office: интерфейс с вкладками в Office и упрощение работы

  • Включение редактирования и чтения с вкладками в Word, Excel, PowerPoint, Издатель, доступ, Visio и проект.
  • Открывайте и создавайте несколько документов на новых вкладках одного окна, а не в новых окнах.
  • Повышает вашу продуктивность на 50% и сокращает количество щелчков мышью на сотни каждый день!
офисный дно
Сортировать комментарии по
Комментарии (28)
Оценок пока нет. Оцените первым!
Этот комментарий был сведен к минимуму модератором на сайте
Как мы можем расширить это, чтобы добавить больше диапазона ячеек? Я добавил эти дополнительные ячейки в код: (Цель, Диапазон («C10: C19», «D10: D19», «E10: E19»)), однако это дает мне ошибку компиляции, говорящую «неправильное количество аргументов или недопустимые назначения свойств», а затем выделяет первую строку кода, которую вы предоставили: «Private Sub Worksheet_BeforeDoubleClick (ByVal Target As Range, Cancel As Boolean)». Пожалуйста, помогите мне.
Этот комментарий был сведен к минимуму модератором на сайте
Джоэл, не знаю, ищете ли вы еще решение, но вам нужно изменить свой код:

От: (Цель, Диапазон("C10:C19", "D10:D19", "E10:E19"))
Кому: (Цель, Диапазон("C10:C19,D10:D19,E10:E19"))

Это сделает это за вас.
Этот комментарий был сведен к минимуму модератором на сайте
Привет, Ник,
Хотелось бы получить от вас совет по этому поводу....
У меня есть файл, который я называю "таблицей производительности".... На этом листе я хотел бы вставить фактическое время в выбранных ячейках, когда ячейка щелкнута... (Если возможно, я бы хотел, чтобы эти ячейки по прошествии времени становится неизменяемым .....что-то вроде блокировки.)
Я ценю ваше время и спасибо заранее
Аттила, Венгрия
exyzee@gmail.com
Этот комментарий был сведен к минимуму модератором на сайте
Дорогой Аттила,
Пожалуйста, попробуйте приведенный ниже снимок экрана, чтобы вставить фактическое время в ячейку в определенном диапазоне при нажатии.
(Функция автоматической блокировки ячеек не может быть достигнута, извините за это)

Private Sub Worksheet_SelectionChange (ByVal Target As Range)
Приложение.ScreenUpdating = False
Если Не Пересечь(Цель, Диапазон("A1:B10")) Ничего, Тогда
Отмена = True
Цель.Формула = Дата
End If
End Sub
Этот комментарий был сведен к минимуму модератором на сайте
Код действительно работает... Спасибо... я добавил еще один код для защиты ячейки после ввода данных. Теперь проблема в том, что, как только я ввожу данные, а ячейка защищена, и по ошибке, если я дважды щелкну защищенную ячейку, приведенный выше код пойдет не так для всего листа. Тогда это не работает. Мне нужно снять защиту с листа, чтобы запустить код. Любое решение?

Используемый код защиты приведен ниже:

Private Sub Worksheet_Change (ByVal Target As Range)
Dim xRg как диапазон
On Error Resume Next
Установите xRg = пересечение (диапазон ("A1: a1000, b1: b1000, G1: G1000"), цель)
Если xRg ничего не значит, выйдите из Sub
Target.Worksheet.Unprotect Password:="123"
xRg.Locked = Истина
Пароль Target.Worksheet.Protect: = "123"
End Sub
Этот комментарий был сведен к минимуму модератором на сайте
Уважаемый Пол,
Я пробую код, который вы предоставили. Весь рабочий лист будет защищен немедленно, как только я введу данные в любую из указанных защищенных ячеек.
Кроме того, при двойном щелчке по защищенной ячейке в моем случае ничего не меняется в коде.
Не могли бы вы объяснить, что именно вы пытаетесь сделать с кодом?
Этот комментарий был сведен к минимуму модератором на сайте
Извините, я понимаю вашу точку зрения. (пропустите приведенный выше код)
Этот комментарий был сведен к минимуму модератором на сайте
Созданный двойной щелчок код ввода:


Private Sub Worksheet_BeforeDoubleClick (ByVal Target As Range, Cancel As Boolean)
Если Не Пересечь(Цель, Диапазон("A1:a1000")) Ничего, Тогда
Отмена = True
Цель.Формула = Дата
End If

Если Не Пересекать(Цель, Диапазон("b1:b1000")) Ничего, Тогда
Отмена = True
Цель.Формула = Время
End If

Если Не Пересекать(Цель, Диапазон("g1:g1000")) Ничего, Тогда
Отмена = True
Цель.Формула = Время
End If
End Sub
Этот комментарий был сведен к минимуму модератором на сайте
Уважаемый Пол,
Пожалуйста, попробуйте следующий код VBA.

Private Sub Worksheet_Change (ByVal Target As Range)
Dim xRg как диапазон
On Error Resume Next
Установите xRg = пересечение (диапазон ("A1: a1000, b1: b1000, G1: G1000"), цель)
Если xRg ничего не значит, выйдите из Sub
Target.Worksheet.Unprotect Password:="123"
xRg.Locked = Истина
Пароль Target.Worksheet.Protect: = "123"
End Sub

Private Sub Worksheet_BeforeDoubleClick (ByVal Target As Range, Cancel As Boolean)
Application.EnableEvents = False
Пароль ActiveSheet.Unprotect: = "123"
Если Не Пересечь(Цель, Диапазон("A1:a1000")) Ничего, Тогда
Отмена = True
Цель.Формула = Дата
End If
Если Не Пересекать(Цель, Диапазон("b1:b1000")) Ничего, Тогда
Отмена = True
Цель.Формула = Время
End If
Если Не Пересекать(Цель, Диапазон("g1:g1000")) Ничего, Тогда
Отмена = True
Цель.Формула = Время
End If
Пароль ActiveSheet.Protect: = "123"
Application.EnableEvents = True
End Sub
Этот комментарий был сведен к минимуму модератором на сайте
Я скопировал и вставил код, обновляющий диапазон, и это не сработало :-(


Private Sub Worksheet_BeforeDoubleClick (ByVal Target As Range, Cancel As Boolean)
Если Не Пересекать(Цель, Диапазон("B4:B100")) Ничего, Тогда
Отмена = True
Цель.Формула = Сейчас()
End If
End Sub
Этот комментарий был сведен к минимуму модератором на сайте
Добрый день,
Код работает хорошо в моем случае. Не подскажешь версию офиса?
Этот комментарий был сведен к минимуму модератором на сайте
Здравствуйте, код, который вы дали, отлично работает. Мне просто любопытно, есть ли способ, чтобы текст «дважды щелкните, чтобы добавить дату» в ячейке до тех пор, пока не будет введена дата. Заранее спасибо (я стараюсь сделать свой документ как можно более удобным для пользователя, чтобы не смущать моих коллег)
Этот комментарий был сведен к минимуму модератором на сайте
Здравствуйте, приведенный выше код отлично сработал для меня. Теперь мне просто интересно, есть ли способ, чтобы текст «Двойной щелчок для ввода даты» отображался в ячейке до тех пор, пока дата не будет введена. Моя цель — сделать документ максимально удобным для пользователя. заранее спасибо
Этот комментарий был сведен к минимуму модератором на сайте
Привет Трэвис,
Мы не можем изменить код, чтобы текст отображался непосредственно в ячейке. Но в качестве альтернативы приведенный ниже оптимизированный код поможет отобразить текст в комментарии к ячейке, и комментарий будет автоматически удален после двойного щелчка по ячейке для ввода даты.

Private Sub Worksheet_SelectionChange (ByVal Target As Range)
Если Не Пересечь(Цель, Диапазон("A1:B10")) Ничего, Тогда
Target.NoteText "дважды щелкните, чтобы добавить дату"
End If
End Sub

Private Sub Worksheet_BeforeDoubleClick (ByVal Target As Range, Cancel As Boolean)
Если Не Пересечь(Цель, Диапазон("A1:B10")) Ничего, Тогда
Отмена = True
Цель.Комментарий.Удалить
Цель.Формула = Дата
End If
End Sub
Этот комментарий был сведен к минимуму модератором на сайте
Всем привет,

Я скопировал и вставил приведенный выше код точно так, как он написан в пустую книгу, однако он у меня не работает. Я просмотрел разные источники в Интернете, и большинство сайтов имеют формат, аналогичный тому, что написано выше. Я думаю, возможно, что-то не так с моим VBA или некоторые настройки не включены. Любые советы будут высоко ценится. Я использую 365-разрядную версию Excel для Office 16.0.11001.20097 MSO (32) в Windows 10.
Этот комментарий был сведен к минимуму модератором на сайте
Мне нравится код, и он отлично работает. Как я могу сделать это, когда я дважды щелкаю, чтобы выполнить код, который показывает время в военное время?
Этот комментарий был сведен к минимуму модератором на сайте
Привет Дилан,
Извините, пока не могу вам с этим помочь. Спасибо за ваш комментарий.
Этот комментарий был сведен к минимуму модератором на сайте
Я думаю, что если вы выберете формат военного времени для этой ячейки в параметрах «Формат» -> «Число» -> «Время» на вашем листе, это должно сработать. Например, он дает вариант 1:30 или 13:30, поэтому вы просто выбираете 13:30, и это должно сработать.
Этот комментарий был сведен к минимуму модератором на сайте
Я думаю, что если вы просто выберете формат военного времени для этой ячейки в параметрах формата «Число» -> «Время», это должно сделать это. Например, вы бы выбрали 13:30 вместо 1:30, и тогда оно должно отображаться в военном времени.
Этот комментарий был сведен к минимуму модератором на сайте
Кто-нибудь знает, есть ли способ вставить этот код в Excel Online? Я использовал его с настольной версией, и он отлично работал, но теперь мы перенесли все на онлайн-платформу, и мои отметки даты и времени при двойном щелчке исчезли, и я не могу понять, как просматривать или редактировать код. Спасибо.
Этот комментарий был сведен к минимуму модератором на сайте
Итак, я вставил код, и он отлично работает на нескольких листах в моей книге, однако на некоторых листах он просто внезапно перестает работать после определенной строки, даже если я ввел правильный диапазон. Любые мысли о том, почему это может произойти.
Этот комментарий был сведен к минимуму модератором на сайте
Это было именно то, что я искал - это сэкономило массу времени, и я ценю хорошо написанные инструкции. Благодарю вас!
Этот комментарий был сведен к минимуму модератором на сайте
Здравствуйте, код очень помог мне. Как я могу ограничить работу кода только в том случае, если поле пусто. Если в ячейке уже есть дата, двойной щелчок не должен ничего делать, с уважением
Этот комментарий был сведен к минимуму модератором на сайте
Привет Ахмад,
Извините за беспокойство. Чтобы заполнить пустые ячейки датами только двойным щелчком, вы можете применить следующий код VBA, чтобы сделать это.
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
Этот комментарий был сведен к минимуму модератором на сайте
Эта функция не работала. Двойной щелчок просто вводит ручное редактирование ячейки.
Этот комментарий был сведен к минимуму модератором на сайте
Привет, Боб,
Код работает хорошо в моем случае. Мне нужно знать больше о вашей проблеме, например, о вашей версии Excel.
И код работает только с указанными вами ячейками.
Этот комментарий был сведен к минимуму модератором на сайте
Всем привет,

Я пытаюсь использовать этот макрос, чтобы использовать отметку даты, дважды щелкнув столбец E, и он работает, но когда я пытаюсь воспроизвести макрос, чтобы сделать то же самое, но в настоящее время в столбце F он не работает, как вы можете видеть в приложении, у меня есть сообщение об ошибке: Обнаружено неоднозначное имя.
Когда я пытаюсь изменить часть Sub WorkSheet на другое имя и дважды щелкаю в ячейках, ничего не происходит.

Может ли кто-нибудь помочь мне в этом?

Мой код:


Sub Worksheet_BeforeDoubleClick (ByVal Target As Range, Cancel As Boolean)
Если Не Пересекать(Цель, Диапазон("E1:E10000")) Ничего, Тогда
Отмена = True
Цель.Формула = Дата
End If
End Sub

Sub Worksheet_BeforeDoubleClick (ByVal Target As Range, Cancel As Boolean)
Если Не Пересекать(Цель, Диапазон("F1:F10000")) Ничего, Тогда
Отмена = True
Цель.Формула = Сейчас()
End If
End Sub
Этот комментарий был сведен к минимуму модератором на сайте
Привет, Луис,
Репликация макроса вызовет две одинаковые процедуры с одинаковыми именами в одном окне кода листа. Excel не допускает двух или более одинаковых имен функций в модуле. Даже в событиях. Это приводит к двусмысленности.
Если вы хотите выполнить другую задачу для того же события, вам необходимо изменить исходный код в соответствии с вашими потребностями.
Следующий код VBA может оказать вам услугу. Пожалуйста, попробуйте.
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
Здесь еще нет комментариев
Оставляйте свои комментарии
Публикация как гость
×
Оценить этот пост:
0   Характеристики
Предлагаемые места

Подписывайтесь на Нас

Copyright © 2009 - www.extendoffice.ком. | Все права защищены. Питаться от ExtendOffice, | Карта сайта
Microsoft и логотип Office являются товарными знаками или зарегистрированными товарными знаками Microsoft Corporation в США и / или других странах.
Защищено Sectigo SSL