Vba excel дата изменения ячейки

Tweaker

Пользователь

Сообщений: 3
Регистрация: 05.06.2019

05.06.2019 15:13:38

Добрый день.
Подскажите код макроса, чтобы при заполнении/изменении значений любой из ячеек в данном ряду таблицы автоматом указывалась текущая дата в отдельной ячейке этого ряда. Ну то есть дата последнего изменения. Нашел что-то похожее, но там только дата изменений одной ячейки, а нужно по диапазону. Понимаю, что скорее всего это делается элементарно, но мои знания VBA очень близки к нулю, поэтому обращаюсь сюда и буду благодарен за любую помощью.
Можно сделать/объяснить на основе приложенного файла.
Тот код что нашел:

Код
Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column = 2 And Target.Row > 1 And Not IsEmpty(Target.Value) Then _ Target.Offset(0, -1).Value = Date End Sub

Прикрепленные файлы

Пример.xlsx (8.45 КБ)

Юрий М

Модератор

Сообщений: 60575
Регистрация: 14.09.2012

Контакты см. в профиле

05.06.2019 15:20:14

Код

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.Count > 1 Then Exit Sub
    If Not Intersect(Target, Range("A2:D5")) Is Nothing Then
        Application.EnableEvents = False
        Cells(Target.Row, 5) = Date
    End If
    Application.EnableEvents = True
End Sub

Tweaker

Пользователь

Сообщений: 3
Регистрация: 05.06.2019

Юрий М, спасибо. Не ожидал столь оперативного ответа. Все работает именно так как нужно.
А можно как-то сделать чтобы при первом внесении информации в одну из ячеек строки или вставки новой строки дата фиксировалась? И после при внесении изменений уже не менялась. Ну то есть в примере одна ячейка — это дата первичного ввода информации, значение которой неизменно, а вторая ячейка (код который Вы написали выше и тут все понятно) — это дата изменений в любой из ячеек строки, и эта дата может меняться.

Юрий М

Модератор

Сообщений: 60575
Регистрация: 14.09.2012

Контакты см. в профиле

05.06.2019 16:19:15

Как зафиксировать дату изменения, обсуждалось неоднократно.

Код

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.Count > 1 Then Exit Sub
    If Not Intersect(Target, Range("A2:D5")) Is Nothing Then
        Application.EnableEvents = False
        If Cells(Target.Row, 5) = "" Then
            Cells(Target.Row, 5) = Date
        Else
            Cells(Target.Row, 6) = Date
        End If
    End If
    Application.EnableEvents = True
End Sub

Tweaker

Пользователь

Сообщений: 3
Регистрация: 05.06.2019

Юрий М, в данном случае получается идет проверка на изменение конкретной ячейки, а не всей строки таблицы. То есть пользователь может сначала заполнить хоть 1 ячейку и «дата внесения» появится и зафиксируется. Дальше пользователь может зайти и заполнить 2-ую ячейку в той же строке и это не будет считаться изменением. И только когда пользователь изменит данные в уже ранее заполненной ячейке, тогда уже появится «дата изменения». Это не совсем то, но хоть что-то.
Еще раз большое Вам спасибо за помощь.

Юрий М

Модератор

Сообщений: 60575
Регистрация: 14.09.2012

Контакты см. в профиле

05.06.2019 18:26:31

Цитата
Tweaker написал: Это не совсем то

А как нужно?

art163

Пользователь

Сообщений: 9
Регистрация: 28.12.2019

28.12.2019 15:33:50

Доброго времени , подскажите , можно ли этот код немного изменить , нужно чтобы он отслеживал изменение в ячейке которое вводиться не вручную , а получается в результате вычисления некой(любой) формулы.

Код

 If Target.Cells.Count > 1 Then Exit Sub 
    If Not Intersect(Target, Range("A2:D5")) Is Nothing Then
        Application.EnableEvents = False
        If Cells(Target.Row, 5) = "" Then
            Cells(Target.Row, 5) = Date
        Else
            Cells(Target.Row, 6) = Date
        End If
    End If
    Application.EnableEvents = True
End Sub

Изменено: art163 — 28.12.2019 21:12:20

Источник

Отображение даты и времени изменения ячейки

ArkaIIIa

Дата: Четверг, 05.06.2014, 16:34 |
Сообщение № 1

Группа: Проверенные

Ранг: Ветеран

Сообщений: 894

Репутация:
115
±

Замечаний:
0% ±

2010

Господа,

В приложенном файле есть готовый макрос, который показывает в столбце B даты и время изменения соответствующих строк столбца A.
Помогите, пожалуйста, преобразовать его таким образом, чтобы он просматривал столбцы, а не строки. Т.е., чтобы при изменении ячейки A1 — в ячейке A5 отображалась дата и время изменения, при изменении ячейки B1 — в B5 и т.д.

К сообщению приложен файл:

__01.xls
(40.5 Kb)

Ответить

Karbofox

Дата: Четверг, 05.06.2014, 16:42 |
Сообщение № 2

Группа: Проверенные

Ранг: Участник

Сообщений: 69

Репутация:
16
±

Замечаний:
0% ±

Excel 2010

Это имелось в виду?
[vba]

Код

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range(«A1:IV1»)) Is Nothing Then
Old_Value = Target.Value
End If
End Sub

[/vba]

Сообщение отредактировал Karbofox — Четверг, 05.06.2014, 16:43

Ответить

ArkaIIIa

Дата: Четверг, 05.06.2014, 16:44 |
Сообщение № 3

Группа: Проверенные

Ранг: Ветеран

Сообщений: 894

Репутация:
115
±

Замечаний:
0% ±

2010

Karbofox
Да, именно это, спасибо большое!

Ответить

Rioran

Дата: Четверг, 05.06.2014, 16:53 |
Сообщение № 4

Группа: Авторы

Ранг: Ветеран

Сообщений: 903

Репутация:
290
±

Замечаний:
0% ±

Excel 2013

ArkaIIIa, здравствуйте.

Посмотрите на такую переделку. Принцип:

1). Поменял EntireColumn.AutoFit на EntireRow.Autofit
2). Поменял каждый Range с A1:A100… на B1:AA4 в обоих макросах листа
3). Поменял Target.Offset(0, 1) на Target.Offset(5 — ActiveCell.Row, 0)

***

По скорости ответа меня опередили =) однако замечу, что в моём решении будет проставляться время, если изменена любая из 4-х строк выше ячейки времени.

К сообщению приложен файл:

one_way.xls
(47.5 Kb)

Сообщение отредактировал Rioran — Четверг, 05.06.2014, 16:55

Ответить

ArkaIIIa

Дата: Четверг, 05.06.2014, 17:13 |
Сообщение № 5

Группа: Проверенные

Ранг: Ветеран

Сообщений: 894

Репутация:
115
±

Замечаний:
0% ±

2010

Rioran
Очень здорово. Но возник вопрос. Почему эти макросы (Ваш и Karbofox`а) работают только во вновь созданных книгах?
При переносе на ранее созданную — почему то они не работают

Ответить

Rioran

Дата: Четверг, 05.06.2014, 17:20 |
Сообщение № 6

Группа: Авторы

Ранг: Ветеран

Сообщений: 903

Репутация:
290
±

Замечаний:
0% ±

Excel 2013

ArkaIIIa, у них нет никакого якоря за книгой. В какой лист их вставите — там и будут работать, лишь бы Range, с которым работаем, на самом листе находился где надо.

***

Попробовал продублировать макросы внутри листа два раза — выдает ошибку. Значит, на одном листе в один и тот же момент должны быть только один Worksheet_Change и Worksheet_SelectionChange

Сообщение отредактировал Rioran — Четверг, 05.06.2014, 17:22

Ответить

ArkaIIIa

Дата: Четверг, 05.06.2014, 17:28 |
Сообщение № 7

Группа: Проверенные

Ранг: Ветеран

Сообщений: 894

Репутация:
115
±

Замечаний:
0% ±

2010

Rioran
Проблема вот в чем. У меня при помощи макроса, который прописан в модуле, из ячеек A1:A20 (условно) копируются и вставляются в ячейки B1:B20 (условно) данные.
Нужно, чтобы в B21 прописывалась дата и время вставки. Вот если руками менять данные в строке, на которую ссылается Ваш или Karbofox`а макрос — то всё ок, дата и время прописываются ниже. А если эти данные вставляются при помощи макроса — то VBA ругается.

Сообщение отредактировал ArkaIIIa — Четверг, 05.06.2014, 17:32

Ответить

ArkaIIIa

Дата: Четверг, 05.06.2014, 17:30 |
Сообщение № 8

Группа: Проверенные

Ранг: Ветеран

Сообщений: 894

Репутация:
115
±

Замечаний:
0% ±

2010

Rioran
Я думал, что макросу все равно, каким образом вносятся изменения в ячейку, и важен сам факт изменения. Но, выходит, что это не так. Почему-то конфликтуют макросы.

Сообщение отредактировал ArkaIIIa — Четверг, 05.06.2014, 17:30

Ответить

ArkaIIIa

Дата: Четверг, 05.06.2014, 17:36 |
Сообщение № 9

Группа: Проверенные

Ранг: Ветеран

Сообщений: 894

Репутация:
115
±

Замечаний:
0% ±

2010

Rioran
В общем, если на живом примере, то вот это в модуле:

[vba]

Код

Sub Update_()
     Path_1 = «F:STALE_APP_REPORT.xls»
     iFileDateTime_1 = FileDateTime(Path_1)
     Cells(27, 11) = iFileDateTime_1
     ActiveWorkbook.UpdateLink Name:= _
         «F:STALE_APP_REPORT.xls», Type:=xlExcelLinks
     Dim r As Range
     Set r = Sheets(7).Rows(2).Find(Sheets(7).[B1].Text, , xlValues, xlWhole)
     If Not r Is Nothing Then
         Sheets(7).[B3:B140].Copy
         r.Offset(1).PasteSpecial Paste:=xlPasteValues
     End If
End Sub

[/vba]

Т.е.
1) Обновляются связи с исходником
2) Прописывается время обновления исходника
3) Данные из ячеек B3:B140 листа7 копируются в соответствующие ячейки на листе 7 (смотрит время обновления исходника и вставляет в столбец, где указано такое же время)
4) Нужно, чтобы в 141 строке тех столбцов, куда вставляются данные, указывалась дата и время этой вставки.

Ответить

Rioran

Дата: Четверг, 05.06.2014, 17:41 |
Сообщение № 10

Группа: Авторы

Ранг: Ветеран

Сообщений: 903

Репутация:
290
±

Замечаний:
0% ±

Excel 2013

ArkaIIIa, Вам нужно чтобы одновременно менялось сразу два значения?

В следующем примере макросы уже, возможно, лишнее и разумнее было бы воспользоваться поиском максимального значения, но машина запущена и сделано макросом, посмотрите =)

Ответить

RAN

Дата: Четверг, 05.06.2014, 17:46 |
Сообщение № 11

Группа: Друзья

Ранг: Экселист

Сообщений: 5645

то это в файле.
Ваша
[vba][/vba]
сама по себе, а ошибка возникает совсем в другом месте.

Ответить

Rioran

Дата: Четверг, 05.06.2014, 17:46 |
Сообщение № 12

Группа: Авторы

Ранг: Ветеран

Сообщений: 903

Репутация:
290
±

Замечаний:
0% ±

Excel 2013

ArkaIIIa, понял, реальная задача оказалась другой. Подумаем.

Ответить

ArkaIIIa

Дата: Пятница, 06.06.2014, 08:11 |
Сообщение № 13

Группа: Проверенные

Ранг: Ветеран

Сообщений: 894

Репутация:
115
±

Замечаний:
0% ±

2010

RAN
Рабочий файл — очень объемный, и там много конфиденциальной информации. Его очень сложно будет почистить, чтобы выложить для примера

Rioran
Разве вставка новых данных в ячейку (т.е. замещение одних данных другими) — не является её изменением?
Мне важно, чтобы макрос вставлял дату и время обновления любой ячейки, в рамках указанного диапазона в одном столбце. Т.е. у меня данные из B3:B140, вставляются в C3:С140, D3:D140 и т.д.
Макрос уважаемого Karbofox`а корректно работает, если данные не копипастятся, а забиваются вручную. Вы могли бы помочь адаптировать его именно под вставляемые данные?
Либо добавить что-то в эту часть макроса:
[vba]

Код

Dim r As Range
      Set r = Sheets(7).Rows(2).Find(Sheets(7).[B1].Text, , xlValues, xlWhole)
      If Not r Is Nothing Then
          Sheets(7).[B3:B140].Copy
          r.Offset(1).PasteSpecial Paste:=xlPasteValues
      End If

[/vba]
, чтобы после вставки значений, строчкой ниже указывалась дата/время вставки?

Извиняюсь, что, возможно, как-то не так изначально сформулировал задачу и большое спасибо за попытку помочь.

Сообщение отредактировал ArkaIIIa — Пятница, 06.06.2014, 08:11

Ответить

ArkaIIIa

Дата: Пятница, 06.06.2014, 08:57 |
Сообщение № 14

Группа: Проверенные

Ранг: Ветеран

Сообщений: 894

Репутация:
115
±

Замечаний:
0% ±

2010

Попробовал смоделировать ситуацию на новом пустом файле.
Использовал макрос:
[vba]

Код

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range(«A1:IV1»)) Is Nothing Then
Application.EnableEvents = False
With Target.Offset(4, 0)
If Target <> Old_Value Then
.Value = Now
.EntireColumn.AutoFit
End If
End With
End If
Application.EnableEvents = True
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range(«A1:IV1»)) Is Nothing Then
Old_Value = Target.Value
End If
End Sub

[/vba]
В случае, если копируется-вставляется 1 ячейка — все в порядке.
В случае, если копируется-вставляется более 1 ячейки — появляется меседжбокс с текстом «Run-time Error `13`: Type mismatch». И после этого в данной книге макрос перестает работать, подсвечивая желтым часть кода:
[vba]

Код

If Target <> Old_Value Then

[/vba]

Ответить

Rioran

Дата: Пятница, 06.06.2014, 10:38 |
Сообщение № 15

Группа: Авторы

Ранг: Ветеран

Сообщений: 903

Репутация:
290
±

Замечаний:
0% ±

Excel 2013

ArkaIIIa, я попробовал кардинально другой подход.

В области А1:J10 (отгорожено серым в файле) вставляйте оптом и смотрите, как меняются подписи на серой панели.

[vba]

Код

Option Explicit
Public Stopper As Boolean

Private Sub Worksheet_Change(ByVal Target As Range)

Application.ScreenUpdating = False

Dim rngX As Range
Dim X As Long

Set rngX = Selection

If Not Intersect(rngX, Range(«a1:j10»)) Is Nothing And Stopper = False Then
     Stopper = True
     For X = 1 To rngX.Columns.Count
         rngX.Cells(1, X).Offset(11 — rngX.Cells(1, X).Row).Value = Now
     Next X
     Stopper = False
End If

Application.ScreenUpdating = True

End Sub

[/vba]

Ответить

ArkaIIIa

Дата: Пятница, 06.06.2014, 11:03 |
Сообщение № 16

Группа: Проверенные

Ранг: Ветеран

Сообщений: 894

Репутация:
115
±

Замечаний:
0% ±

2010

Rioran
Если руками копирую — вставляю — всё хорошо. Если использую макрос вставки, вот этот:
[vba]

Код

    Dim r As Range
     Set r = Sheets(7).Rows(2).Find(Sheets(7).[B1].Text, , xlValues, xlWhole)
     If Not r Is Nothing Then
         Sheets(7).[B3:B140].Copy
         r.Offset(1).PasteSpecial Paste:=xlPasteValues
     End If

[/vba]
, то выдает ошибку Run-time Error 1004: Method `Intersect` of object`_Global`failed
Т.е. я само-собой меняю указанный в Вашем макросе диапазон «a1:j10» на свой «c28:aj140» и строку с 11 на 141, и при вставке руками — все нормально работает. А вот, когда юзаю макрос вставки — беда.

Ответить

ArkaIIIa

Дата: Пятница, 06.06.2014, 11:14 |
Сообщение № 17

Группа: Проверенные

Ранг: Ветеран

Сообщений: 894

Репутация:
115
±

Замечаний:
0% ±

2010

Rioran
Нет, Вы знаете, видимо конфликт не с макросом вставки. Попробовал сделать на новом файле — все нормально работает. Сейчас более расширенный пример попробую сделать и закинуть.

Ответить

Rioran

Дата: Пятница, 06.06.2014, 11:24 |
Сообщение № 18

Группа: Авторы

Ранг: Ветеран

Сообщений: 903

Репутация:
290
±

Замечаний:
0% ±

Excel 2013

Всё дело в том, что в моём макросе простановка изменений по столбцу привязана к выделению. Просто симитируйте выделение мышью, как например здесь:

[vba]

Код

Sub Data_Transition_2()

Range(«m1:N3»).Copy
Range(«F2»).Select
Worksheets(«Tryal»).Paste

End Sub

[/vba]
Файл с кнопкой для теста прилагаю.

К сообщению приложен файл:

2747659.xlsm
(22.3 Kb)

Сообщение отредактировал Rioran — Пятница, 06.06.2014, 11:25

Ответить

ArkaIIIa

Дата: Пятница, 06.06.2014, 11:43 |
Сообщение № 19

Группа: Проверенные

Ранг: Ветеран

Сообщений: 894

Репутация:
115
±

Замечаний:
0% ±

2010

Rioran
Прикладываю файл. Голова кругом идет, не знаю, с чем связана ошибка
Попробую еще раз по порядку описать ситуацию на примере файла из приложения.

— Есть файл (файл из приложения), в котороый по связям из другого файла подтягиваются данные. Файл исходник обновляется автоматически каждые полчаса. Таким образом, при каждом обновлении файла из примера раз в полчаса — он подтягивает обновленные данные.
— Есть 2 макроса, засунутых в один модуль:
Первый:
[vba]

Код

[/vba]
Прописывает в ячейку K27 время последнего обновления файла-исходника, откуда тянутся данные в файл-пример.
Второй:
[vba]

Код

[/vba]
Берет данные из ячеек столбца B3:B140, смотрит значение времени, указанное в ячейке B1, находит в строке 2 аналогичное время, и вставляет скопированные данные.
— Нужен третий макрос, который указывал бы строчкой ниже вставленных данных (т.е. 141-ой), дату и время этой вставки.

Ваш макрос (условно назовем его Макрос № 3) работает:
— Если копировать-вставлять руками
— Если копировать-вставлять макросом вставки (№2, из описания выше)
— Но вот если задействовано все 3 макроса — то возникает сообщение: Run-time Error 1004: Method `Intersect` of object`_Global`failed

Я не понимаю, на каком этапе возникает конфликт

К сообщению приложен файл:

11.xlsm
(24.4 Kb)

Сообщение отредактировал ArkaIIIa — Пятница, 06.06.2014, 11:44

Ответить

RAN

Дата: Пятница, 06.06.2014, 12:19 |
Сообщение № 20

Группа: Друзья

Ранг: Экселист

Сообщений: 5645

Ваш файлик как бы поломатый.

К сообщению приложен файл:

3474154.jpg
(18.9 Kb)

Сообщение отредактировал RAN — Пятница, 06.06.2014, 12:21

Ответить

Источник

Как автоматически записывать дату и время при изменении ячейки?

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

Автоматическая запись даты и времени при изменении ячейки с помощью кода VBA

Автоматическая запись даты и времени при изменении ячейки с помощью кода VBA

Например, у меня есть диапазон значений, и теперь, когда я изменяю или ввожу новые значения в столбец B, я хочу, чтобы в столбце C автоматически записывались текущая дата и время, как показано на следующем снимке экрана:

Вы можете завершить эту задачу с помощью следующего кода VBA. Пожалуйста, сделайте так:

1. Удерживайте ALT + F11 , чтобы открыть Окно Microsoft Visual Basic для приложений.

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

3. Затем сохраните и закройте этот код, чтобы вернуться на рабочий лист, теперь, когда вы изменяете значение ячейки или вводите новые данные в столбец B, дата и время будут автоматически записываться в столбец C.

Ноты:

1. В приведенном выше коде вы можете изменить «B: B”В любой другой столбец, значения ячеек которого вы хотите изменить в этом скрипте: Установите WorkRng = Intersect (Application.ActiveSheet.Range («B: B»), Target).

2. С этим xOffsetColumn = 1 скрипт, вы можете вставить и обновить дату и время в первом столбце рядом с вашим столбцом изменяющегося значения, вы можете изменить число 1 на другие числа, такие как 2,3,4,5… это означает, что дата будет вставлена второй, третий, четвертый или пятый столбцы помимо столбца измененных значений.

3. Когда вы удаляете значение в измененном столбце, дата и время также удаляются.

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

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

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

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

Включение редактирования и чтения с вкладками в Word, Excel, PowerPoint, Издатель, доступ, Visio и проект.
Открывайте и создавайте несколько документов на новых вкладках одного окна, а не в новых окнах.
Повышает вашу продуктивность на 50% и сокращает количество щелчков мышью на сотни каждый день!

Комментарии (108)

Оценок пока нет. Оцените первым!

Источник

ArtistJoker

0 / 0 / 0

Регистрация: 18.11.2015

Сообщений: 2

18.11.2015, 17:43. Показов 9182. Ответов 11

Метки нет (Все метки)

Привет, форумчане!

Очень прошу помочь. На работе заполняю отчёт, в котором вручную приходится вставлять дату изменений строки(не просто ячейки) с информацией по клиенту. Искал в сети помощь, нашёл только вот такой код (внесение даты изменений соседней ячейки):
———————————————————————————————————————

Visual Basic

Private Sub Worksheet_Change(ByVal Target As Range)
     
    For Each cell In Target   'проходим по всем измененным ячейкам
       If Not Intersect(cell, Range("A2:A100")) Is Nothing Then  'если изменененная ячейка попадает в диапазон A2:A100
            With cell.Offset(0, 1)         'вводим в соседнюю справа ячейку дату
               .Value = Now
               .EntireColumn.AutoFit  'выполняем автоподбор ширины для столбца B, чтобы дата умещалась в ячейке
            End With
       End If
    Next cell
End Sub

———————————————————————————————————————-
Может быть в этом коде можно внести изменения, чтобы при изменении строки автоматически вставлялась дата в первую ячейку строки. Как это сделать?

Заранее благодарен!

Вложения

Пример отчёта.xlsx (10.1 Кб, 39 просмотров)

Vlad999

3827 / 2254 / 751

Регистрация: 02.11.2012

Сообщений: 5,930

18.11.2015, 17:58

Сообщение было отмечено ArtistJoker как решение

Решение

Visual Basic

Private Sub Worksheet_Change(ByVal Target As Range)
Dim cell As Range
Application.EnableEvents = False
For Each cell In Target 'проходим по всем измененным ячейкам
  If Not Intersect(cell, Range("B2:H100")) Is Nothing Then 'если изменененная ячейка попадает в диапазон A2:A100
     With Cells(cell.Row, 1) 'вводим в первый столбец текущей строки ячейку дату
     .Value = Now
     .EntireColumn.AutoFit 'выполняем автоподбор ширины для столбца B, чтобы дата умещалась в ячейке
     End With
   End If
Next cell
Application.EnableEvents = True
End Sub

pashulka

4131 / 2235 / 940

Регистрация: 01.12.2010

Сообщений: 4,624

18.11.2015, 18:59

Альтернативный вариант (на основании выложенного примера)

Visual Basic

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Row > 4 Then
       Application.EnableEvents = False
       With Intersect(Target.EntireRow, [A:A])
            .Value = Date
            .Columns.AutoFit
       End With: [H1] = Now
       Application.EnableEvents = True
    End If
End Sub

или

Visual Basic

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Row > 4 Then
       Application.EnableEvents = False
       Intersect(Target.EntireRow, [A:A]) = Date
       [H1] = Now: Columns(1).AutoFit
       Application.EnableEvents = True
    End If
End Sub

0 / 0 / 0

Регистрация: 18.11.2015

Сообщений: 2

23.11.2015, 17:10

[ТС]

Спасибо, огромное! Всё работает как надо!

0 / 0 / 0

Регистрация: 12.02.2020

Сообщений: 23

07.07.2020, 20:58

Подскажите как подкорректировать для моего случая:
На первом листе книги имеется диапазон ячеек например А2:V20. В каждую ячейку которого вносятся числовые значения.
Нужно зеркально в те же ячейки на втором листе книги вносить дату и время изменения значения ячеек на первом листе книги.

4131 / 2235 / 940

Регистрация: 01.12.2010

Сообщений: 4,624

07.07.2020, 21:00

gpetrv, Скажите чей вариант Вы выбрали ?

0 / 0 / 0

Регистрация: 12.02.2020

Сообщений: 23

07.07.2020, 22:38

pashulka, Мне все равно чей вариант, лишь бы рабочий……и универсальный (изменять диапазоны ячеек)

pashulka

4131 / 2235 / 940

Регистрация: 01.12.2010

Сообщений: 4,624

07.07.2020, 22:40

Next — следующий лист.

Visual Basic

Private Sub Worksheet_Change(ByVal r As Range)
   Set r = Intersect(r, [A2:V20])
   If r Is Nothing Then Exit Sub
   
   Application.EnableEvents = False
   With Me.Next.Range(r.Address)
        .Value = Now
        .Columns.AutoFit
   End With
   Application.EnableEvents = True
End Sub

0 / 0 / 0

Регистрация: 12.02.2020

Сообщений: 23

07.07.2020, 22:51

pashulka, А на первом листе?

4131 / 2235 / 940

Регистрация: 01.12.2010

Сообщений: 4,624

07.07.2020, 23:18

gpetrv, В модуле первого листа — событие Worksheet_Change. Тогда на следующем — будет выводиться дата+время изменения данных ячеек диапазона A2:V20

Если месторасположение второго рабочего листа, в дальнейшем, может меняться, то можно использовать имя этого листа или кодовое(программное) имя. Т.е. вместо Me.Next написать Worksheets(«Лист2») или Лист2 . Разумеется, имена нужно указать свои.

0 / 0 / 0

Регистрация: 12.02.2020

Сообщений: 23

29.07.2020, 21:21

pashulka, не могу скомпоновать со своим кодом. Не силен…. Помогите..

pashulka

4131 / 2235 / 940

Регистрация: 01.12.2010

Сообщений: 4,624

29.07.2020, 22:24

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

~~перерывчик небольшой~~

строкой просто добавьте

Visual Basic

    Application.EnableEvents = False '1
    With Me.Next.Range(r.Address)
        .Value = Now
        .Columns.AutoFit
    End With
    For Each c In r '2

IT_Exp Эксперт 87844 / 49110 / 22898 Регистрация: 17.06.2006 Сообщений: 92,604	29.07.2020, 22:24
12

Источник

Karbofox

Дата: Четверг, 05.06.2014, 16:42 | Сообщение № 2

200?’200px’:»+(this.scrollHeight+5)+’px’);»> Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range(«A1:IV1»)) Is Nothing Then
Application.EnableEvents = False
With Target.Offset(4, 0)
If Target <> Old_Value Then
.Value = Now
.EntireColumn.AutoFit
End If
End With
End If
Application.EnableEvents = True
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range(«A1:IV1»)) Is Nothing Then
Old_Value = Target.Value
End If
End Sub

ArkaIIIa

Дата: Четверг, 05.06.2014, 16:44 | Сообщение № 3

Rioran

Дата: Четверг, 05.06.2014, 16:53 | Сообщение № 4

Посмотрите на такую переделку. Принцип:

1). Поменял EntireColumn.AutoFit на EntireRow.Autofit
2). Поменял каждый Range с A1:A100. на B1:AA4 в обоих макросах листа
3). Поменял Target.Offset(0, 1) на Target.Offset(5 — ActiveCell.Row, 0)

Посмотрите на такую переделку. Принцип:

По скорости ответа меня опередили =) однако замечу, что в моём решении будет проставляться время, если изменена любая из 4-х строк выше ячейки времени. Rioran

Сообщение ArkaIIIa, здравствуйте.

Посмотрите на такую переделку. Принцип:

По скорости ответа меня опередили =) однако замечу, что в моём решении будет проставляться время, если изменена любая из 4-х строк выше ячейки времени. Автор — Rioran
Дата добавления — 05.06.2014 в 16:53

ArkaIIIa

Дата: Четверг, 05.06.2014, 17:13 | Сообщение № 5

Rioran

Дата: Четверг, 05.06.2014, 17:20 | Сообщение № 6

Сообщение ArkaIIIa, у них нет никакого якоря за книгой. В какой лист их вставите — там и будут работать, лишь бы Range, с которым работаем, на самом листе находился где надо.

ArkaIIIa

Дата: Четверг, 05.06.2014, 17:28 | Сообщение № 7

ArkaIIIa

Дата: Четверг, 05.06.2014, 17:30 | Сообщение № 8

ArkaIIIa

Дата: Четверг, 05.06.2014, 17:36 | Сообщение № 9

Rioran
В общем, если на живом примере, то вот это в модуле:

Сообщение Rioran
В общем, если на живом примере, то вот это в модуле:

Rioran

Дата: Четверг, 05.06.2014, 17:41 | Сообщение № 10

ArkaIIIa, Вам нужно чтобы одновременно менялось сразу два значения?

В следующем примере макросы уже, возможно, лишнее и разумнее было бы воспользоваться поиском максимального значения, но машина запущена и сделано макросом, посмотрите =) Rioran

Сообщение ArkaIIIa, Вам нужно чтобы одновременно менялось сразу два значения?

В следующем примере макросы уже, возможно, лишнее и разумнее было бы воспользоваться поиском максимального значения, но машина запущена и сделано макросом, посмотрите =) Автор — Rioran
Дата добавления — 05.06.2014 в 17:41

RAN

Дата: Четверг, 05.06.2014, 17:46 | Сообщение № 11

Rioran

Дата: Четверг, 05.06.2014, 17:46 | Сообщение № 12

ArkaIIIa

Дата: Пятница, 06.06.2014, 08:11 | Сообщение № 13

RAN
Рабочий файл — очень объемный, и там много конфиденциальной информации. Его очень сложно будет почистить, чтобы выложить для примера 🙁

[/vba]
, чтобы после вставки значений, строчкой ниже указывалась дата/время вставки?

Извиняюсь, что, возможно, как-то не так изначально сформулировал задачу и большое спасибо за попытку помочь.

[/vba]
, чтобы после вставки значений, строчкой ниже указывалась дата/время вставки?

Извиняюсь, что, возможно, как-то не так изначально сформулировал задачу и большое спасибо за попытку помочь. ArkaIIIa

Сообщение RAN
Рабочий файл — очень объемный, и там много конфиденциальной информации. Его очень сложно будет почистить, чтобы выложить для примера 🙁

[/vba]
, чтобы после вставки значений, строчкой ниже указывалась дата/время вставки?

Извиняюсь, что, возможно, как-то не так изначально сформулировал задачу и большое спасибо за попытку помочь. Автор — ArkaIIIa
Дата добавления — 06.06.2014 в 08:11

Источник

Adblock
detector

Источник