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

Як автоматично заповнити дату в комірці, коли сусідня комірка оновлюється в Excel?

Іноді, під час оновлення комірки в певному стовпці, вам може знадобитися позначити останню дату оновлення. У цій статті буде рекомендовано метод VBA для вирішення цієї проблеми. Коли осередок оновиться, сусідня комірка негайно автоматично заповниться поточною датою.

Автоматично заповнювати поточну дату в комірці, коли сусідня комірка оновлюється кодом VBA


Автоматично заповнювати поточну дату в комірці, коли сусідня комірка оновлюється кодом VBA

Припустимо, дані, які вам потрібно оновити, знаходять у стовпці B, і коли осередок у стовпці B оновлюється, поточна дата буде заповнена у сусідній комірці стовпця A. Дивіться знімок екрана:

Ви можете запустити такий код VBA, щоб вирішити цю проблему.

1. Клацніть правою кнопкою миші вкладку аркуша, яку потрібно автоматично заповнити датою на основі сусідньої оновленої комірки, а потім натисніть Переглянути код з меню, що клацне правою кнопкою миші.

2. У вікні Microsoft Visual Basic for Applications скопіюйте та вставте наведений нижче код VBA у вікно коду.

Код VBA: автоматичне заповнення поточної дати в комірці, коли сусідня комірка оновлюється

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
'Updated by Extendoffice 2017/10/12
    Dim xRg As Range, xCell As Range
    On Error Resume Next
    If (Target.Count = 1) Then
        If (Not Application.Intersect(Target, Me.Range("B:B")) Is Nothing) Then _
            Target.Offset(0, -1) = Date
        Application.EnableEvents = False
        Set xRg = Application.Intersect(Target.Dependents, Me.Range("B:B"))
        If (Not xRg Is Nothing) Then
            For Each xCell In xRg
                xCell.Offset(0, -1) = Date
            Next
        End If
        Application.EnableEvents = True
    End If
End Sub

примітки:

1). У коді B: B означає, що оновлені дані знаходяться в стовпці B.
2). -1 означає, що поточна дата буде заповнена в лівому стовпці стовпця B. Якщо ви хочете, щоб поточна дата заповнилася в стовпці C, змініть -1 на 1.

3. прес інший + Q клавіші одночасно, щоб закрити Microsoft Visual Basic для додатків вікна.

Відтепер при оновленні комірок у стовпці B сусідня комірка у стовпці A буде негайно заповнена поточною датою. Дивіться знімок екрана:


Статті по темі:


Найкращі інструменти для підвищення продуктивності офісу

Kutools для Excel вирішує більшість ваших проблем і збільшує продуктивність на 80%

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

Вкладка Office забезпечує інтерфейс з вкладками для Office і значно спрощує вашу роботу

  • Увімкніть редагування та читання на вкладках у Word, Excel, PowerPoint, Publisher, Access, Visio та Project.
  • Відкривайте та створюйте кілька документів на нових вкладках того самого вікна, а не в нових вікнах.
  • Збільшує вашу продуктивність на 50% та зменшує сотні клацань миші для вас щодня!
дно офісної таблиці
Коментарі (40)
Поки немає оцінок. Оцініть першим!
Цей коментар був мінімізований модератором на сайті
Дякую. Це дуже допомогло. Але коли я видаляю рядок або додаю рядок, це дає помилку під час виконання 13 Невідповідність типу. Як вирішити цю проблему. Очікується повернення якнайшвидше.
Цей коментар був мінімізований модератором на сайті
Шановний Джішну,
Проблема, про яку ви згадали, не з’являється в моєму випадку. Надайте, будь ласка, свою версію Office?
Цей коментар був мінімізований модератором на сайті
У мене є набір робочих аркушів Excel під назвою понеділок, вівторок, середа тощо. Мені потрібно вказати дату початку понеділка в клітинку a1 і заповнити наступні дати з вівторка по п’ятницю в клітинці a1 на кожному з цих аркушів. Я взагалі не розбираюся в коді, тому мені просто потрібно знати, яку просту формулу я можу ввести. :) Дякую!
Цей коментар був мінімізований модератором на сайті
дорога Лія,
Вам просто потрібно використовувати формулу =понеділок!А1+1 у вівторок на аркуші, =вівторок!А1+1 на аркуші середа і так далі...
Цей коментар був мінімізований модератором на сайті
Чи можна це зробити на комірці, яка містить формулу?
Цей коментар був мінімізований модератором на сайті
Шановна Таммі,
Код оновлено. Це можна виконати на клітинці, яка містить формулу. Дякуємо за коментар.
Цей коментар був мінімізований модератором на сайті
Дякую, все працює добре, але коли справа доходить до закриття та збереження, я отримую повідомлення про те, що функцію «Проект VB» неможливо зберегти в книзі без макросів. Порадьте, будь ласка
Цей коментар був мінімізований модератором на сайті
Дякую, все працює добре, але коли справа доходить до закриття та збереження, я отримую повідомлення про те, що функцію «Проект VB» неможливо зберегти в книзі без макросів. Порадьте, будь ласка
Цей коментар був мінімізований модератором на сайті
Вам просто потрібно «зберегти як» робочу книгу Excel з підтримкою макросів....
Цей коментар був мінімізований модератором на сайті
Чи можете ви використовувати цю функцію двічі на одному аркуші? тобто якщо я хотів би внести записи в стовпець B до стовпця A відмітки часу І внести записи в стовпець D до стовпця C із міткою часу. Дякую!
Цей коментар був мінімізований модератором на сайті
Я змусив це працювати, виконавши наступне:


Приватний допоміжний робочий лист_Зміна (за значенням цілі як Excel. Діапазон)
'Оновлено Extendoffice 2017 / 10 / 12
Dim xRg як діапазон, xCell як діапазон
On Error Resume Next
Якщо (Target.Count = 1) Тоді
Якщо (не Application.Intersect(Target, Me.Range("B:B")) Нічого), то _
Target.Offset(0, -1) = Дата
Application.EnableEvents = False
Встановіть xRg = Application.Intersect(Target.Dependents, Me.Range("B:B"))
Якщо (Not xRg Is Nothing) Тоді
Для кожного xCell In xRg
xCell.Offset(0, -1) = Дата
Далі
End If
Application.EnableEvents = True
End If


On Error Resume Next
Якщо (Target.Count = 1) Тоді
Якщо (не Application.Intersect(Target, Me.Range("D:D")) Нічого) то _
Target.Offset(0, -1) = Дата
Application.EnableEvents = False
Встановіть xRg = Application.Intersect(Target.Dependents, Me.Range("D:D"))
Якщо (Not xRg Is Nothing) Тоді
Для кожного xCell In xRg
xCell.Offset(0, -1) = Дата
Далі
End If
Application.EnableEvents = True
End If
End Sub
Цей коментар був мінімізований модератором на сайті
привіт,

Чи може хтось запропонувати код, коли я вводжу число в стовпці A і стовпці B, а в стовпці CI зберігається формула, наприклад, стовпець A + стовпець B. Тепер мені потрібен код vba, який може вказувати час і дату в стовпці D, коли змінюється стовпець C не при вставці чисел у стовпці A і B.
Цей коментар був мінімізований модератором на сайті
Хороший день,
Будь-які запитання щодо Excel, будь ласка, не соромтеся публікувати на нашому форумі: https://www.extendoffice.com/forum.html.
Ви отримаєте додаткову підтримку щодо Excel від нашого спеціаліста з Excel.
Цей коментар був мінімізований модератором на сайті
HI – нове в VBA – Я хочу зациклити код – Код VBA: автоматично заповнювати поточну дату в комірці, коли сусідня клітинка оновлюється, щоб після оновлення клітинки датою, потім перейдіть до слова «J:J» і оновіть K датою, а потім зробіть ще 2 рази. Не впевнені, це цикл чи for? Дякую
Цей коментар був мінімізований модератором на сайті
Неважливо...Я спробував відповідь Джона нижче, і вона працює - дякую!
Цей коментар був мінімізований модератором на сайті
Я використав цей код для автоматичного заповнення стовпця, і тепер хочу автоматично заповнити більше стовпців на основі дати, введеної в стовпець H. Іншими словами, після введення дати я можу автоматично заповнити стовпці, щоб додати дату 90, 60 і 30 днів. ?
Цей коментар був мінімізований модератором на сайті
Привіт Трейсі!
Наведений нижче код VBA може допомогти вам вирішити проблему. Будь ласка, спробуйте.

Приватний допоміжний робочий лист_Зміна (за значенням цілі як Excel. Діапазон)
Dim xRg як діапазон, xCell як діапазон
Dim xRgAddress як рядок
xRgAddress = "H:H"
On Error Resume Next
Якщо (Target.count = 1) Тоді
Якщо (не Application.Intersect(Target, Me.Range(xRgAddress)) Нічого), то
Target.Offset(0, 1) = Дата + 90
Target.Offset(0, 2) = Дата + 60
Target.Offset(0, 3) = Дата + 30
End If
Application.EnableEvents = False
Встановіть xRg = Application.Intersect(Target.Dependents, Me.Range(xRgAddress))
Якщо (Not xRg Is Nothing) Тоді
Для кожного xCell In xRg
xCell.Offset(0, 1) = Дата + 90
xCell.Offset(0, 2) = Дата + 60
xCell.Offset(0, 3) = Дата + 30
Далі
End If
Application.EnableEvents = True
End If
End Sub
Цей коментар був мінімізований модератором на сайті
Привіт. Я намагаюся використовувати "Автоматично заповнювати поточну дату в клітинці, коли сусідня клітинка оновлюється за допомогою коду VBA". Це працює на аркуші 1, але у мене є 11 інших аркушів, над якими мені потрібен код. Порадьте, будь ласка. Я взагалі не розбираюся в VBA, тому ціную будь-яку допомогу!

Завдяки.
Цей коментар був мінімізований модератором на сайті
Привіт, Гвен,
Повторіть кроки, щоб скопіювати код на інші аркуші. Це може бути нудно, але це працює.
Цей коментар був мінімізований модератором на сайті
Привіт, мені потрібна допомога. Я намагаюся заповнити поточну дату в стовпець A, якщо будь-які клітинки B–N змінено. Зміщення мене скидає. Чи можна написати цей код для автоматичного заповнення дати в стовпці А?
Цей коментар був мінімізований модератором на сайті
Привіт Джо,
Наведений нижче код VBA може допомогти вам вирішити проблему. Будь ласка, спробуйте і дякую за ваш коментар.

Приватний допоміжний робочий лист_Зміна (за значенням цілі як Excel. Діапазон)
'Оновлено Extendoffice 20190924
Dim xRg як діапазон, xCell як діапазон
Dim xInt як ціле число
On Error Resume Next
Якщо (Target.Count = 1) Тоді
Якщо (не Application.Intersect(Target, Me.Range("B:N")) Нічого), то
Application.EnableEvents = False
xInt = Target.Row
Me.Range("A" & xInt).Value = Дата
Application.EnableEvents = True
End If
End If
End Sub
Цей коментар був мінімізований модератором на сайті
Привіт, чи можу я встановити дату та час для заповнення?
Цей коментар був мінімізований модератором на сайті
Привіт, абатство!
У наведеному вище коді замініть цей рядок
"xCell.Offset(0, -1) = Дата"
з
"xCell.Offset(0, -1) = Формат(Зараз(), "рррр-ММ-дд год: мм:сс")".
Сподіваюся, що зможу допомогти. Дякуємо за коментар.
Цей коментар був мінімізований модератором на сайті
це не додає часу... чи є інший спосіб?
Цей коментар був мінімізований модератором на сайті
вам потрібно змінити його в 2 місцях, якщо ви бачите оригінальний код, дата в 2 місцях, змініть обидва за допомогою Format(Now(), "yyyy-MM-dd hh:mm:ss")
Цей коментар був мінімізований модератором на сайті
Привіт, чи є спосіб зробити стовпець (A) автоматично заповненим датою під час введення значення в будь-яку клітинку в тому ж рядку?
Цей коментар був мінімізований модератором на сайті
Привіт, Гаррі,
Наведений нижче код VBA може допомогти вам вирішити проблему. Будь ласка, вкажіть діапазон якомога більше в коді. Дякуємо за коментар.

Приватний допоміжний робочий лист_Зміна (за значенням цілі як Excel. Діапазон)
'Оновлено Extendoffice 20191017
Dim xRg як діапазон, xCell як діапазон
Dim xInt як ціле число
On Error Resume Next
Якщо (Target.Count = 1) Тоді
Якщо (не Application.Intersect(Target, Me.Range("B:BP")) Нічого), то
Application.EnableEvents = False
xInt = Target.Row
Me.Range("A" & xInt).Value = Дата
Application.EnableEvents = True
End If
End If
End Sub
Цей коментар був мінімізований модератором на сайті
Я думаю, що потрібно змінити також рядок 7...
Цей коментар був мінімізований модератором на сайті
Хтось знає, чи є спосіб автоматичного заповнення та блокування, щоб запобігти введенню зміни дати? Коли я блокую клітинки та захищаю документ, клітинки взагалі не заповнюються.
Цей коментар був мінімізований модератором на сайті
Я хочу вводити не дату, а константу в клітинку, наприклад: число або текстовий рядок. будь ласка, запропонуйте змінити код для того самого.
Дякую
Цей коментар був мінімізований модератором на сайті
Привіт! Якщо ви хочете ввести число, будь ласка, замініть текст Дата з номер безпосередньо в коді. Щоб ввести текстовий рядок, замініть текст Дата в коді з "ваш текстовий рядок" (подвійні лапки включені).
Приватний допоміжний робочий лист_Зміна (за значенням цілі як Excel. Діапазон)
'Оновлено Extendoffice 2020 / 09 / 28
Dim xRg як діапазон, xCell як діапазон
On Error Resume Next
Якщо (Target.Count = 1) Тоді
Якщо (не Application.Intersect(Target, Me.Range("B:B")) Нічого), то _
Target.Offset(0, -1) = "текстовий рядок" 'Або безпосередньо введіть число
Application.EnableEvents = False
Встановіть xRg = Application.Intersect(Target.Dependents, Me.Range("B:B"))
Якщо (Not xRg Is Nothing) Тоді
Для кожного xCell In xRg
xCell.Offset(0, -1) = "текстовий рядок" 'Або безпосередньо введіть число
Далі
End If
Application.EnableEvents = True
End If
End Sub
Цей коментар був мінімізований модератором на сайті
Я вводжу цей код у свою книгу Excel, і нічого не відбувається. Чи може хтось допомогти? В ідеалі я хотів би, коли щось поміщається в стовпець А, час ставиться в стовпець B.
Цей коментар був мінімізований модератором на сайті
Привіт, чапо, спробуйте наведений нижче код. Сподіваюся, що зможу допомогти. Приватний допоміжний робочий лист_Зміна (за значенням цілі як Excel. Діапазон)
'Оновлено Extendoffice 2020 / 10 / 12
Dim xRg як діапазон, xCell як діапазон
On Error Resume Next
Якщо (Target.Count = 1) Тоді
Якщо (не Application.Intersect(Target, Me.Range("A:A")) Нічого) то _
Target.Offset(0, 1) = Час
Application.EnableEvents = False
Встановіть xRg = Application.Intersect(Target.Dependents, Me.Range("A:A"))
Якщо (Not xRg Is Nothing) Тоді
Для кожного xCell In xRg
xCell.Offset(0, 1) = Час
Далі
End If
Application.EnableEvents = True
End If
End Sub
Цей коментар був мінімізований модератором на сайті
Привіт, я використовую ваш код як довідник. Я хочу запитати, чи можна мати наступне: 1. Запобігайте повторюваним записам дати2. Мати 2 макровходи одночасно: Target.Offset(0,-1), Target,Offset(0,1)3. Чи можна автоматично вставити зображення в клітинку?
Я намагався зрозуміти це сам, але я не можу знайти в Інтернеті жодних ресурсів, які могли б мені допомогти
Цей коментар був мінімізований модератором на сайті
Привіт, ця формула чудово працює. Однак чи є спосіб встановити, що він оновлює клітинку в стовпці A, лише якщо вона порожня?  
Цей коментар був мінімізований модератором на сайті
Привіт, Метт, вибачте, я не зовсім розумію, що ви маєте на увазі. Чи можете ви спробувати уточнити своє запитання або надати скріншот того, що ви намагаєтеся зробити?
There are no comments posted here yet
Load More
Залишайте свої коментарі
Публікація як гість
×
Оцініть цю публікацію:
0  Персонажі
Рекомендовані місця