В приложенном файле есть готовый макрос, который показывает в столбце B даты и время изменения соответствующих строк столбца A. Помогите, пожалуйста, преобразовать его таким образом, чтобы он просматривал столбцы, а не строки. Т.е., чтобы при изменении ячейки A1 - в ячейке A5 отображалась дата и время изменения, при изменении ячейки B1 - в B5 и т.д.
Господа,
В приложенном файле есть готовый макрос, который показывает в столбце B даты и время изменения соответствующих строк столбца A. Помогите, пожалуйста, преобразовать его таким образом, чтобы он просматривал столбцы, а не строки. Т.е., чтобы при изменении ячейки A1 - в ячейке A5 отображалась дата и время изменения, при изменении ячейки B1 - в B5 и т.д.ArkaIIIa
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]
Это имелось в виду? [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
1). Поменял EntireColumn.AutoFit на EntireRow.Autofit 2). Поменял каждый Range с A1:A100... на B1:AA4 в обоих макросах листа 3). Поменял Target.Offset(0, 1) на Target.Offset(5 - ActiveCell.Row, 0)
***
По скорости ответа меня опередили =) однако замечу, что в моём решении будет проставляться время, если изменена любая из 4-х строк выше ячейки времени.
ArkaIIIa, здравствуйте.
Посмотрите на такую переделку. Принцип:
1). Поменял EntireColumn.AutoFit на EntireRow.Autofit 2). Поменял каждый Range с A1:A100... на B1:AA4 в обоих макросах листа 3). Поменял Target.Offset(0, 1) на Target.Offset(5 - ActiveCell.Row, 0)
***
По скорости ответа меня опередили =) однако замечу, что в моём решении будет проставляться время, если изменена любая из 4-х строк выше ячейки времени.Rioran
Rioran Очень здорово. Но возник вопрос. Почему эти макросы (Ваш и Karbofox`а) работают только во вновь созданных книгах? При переносе на ранее созданную - почему то они не работают :-(
Rioran Очень здорово. Но возник вопрос. Почему эти макросы (Ваш и Karbofox`а) работают только во вновь созданных книгах? При переносе на ранее созданную - почему то они не работают :-(ArkaIIIa
ArkaIIIa, у них нет никакого якоря за книгой. В какой лист их вставите - там и будут работать, лишь бы Range, с которым работаем, на самом листе находился где надо.
***
Попробовал продублировать макросы внутри листа два раза - выдает ошибку. Значит, на одном листе в один и тот же момент должны быть только один Worksheet_Change и Worksheet_SelectionChange
ArkaIIIa, у них нет никакого якоря за книгой. В какой лист их вставите - там и будут работать, лишь бы Range, с которым работаем, на самом листе находился где надо.
***
Попробовал продублировать макросы внутри листа два раза - выдает ошибку. Значит, на одном листе в один и тот же момент должны быть только один Worksheet_Change и Worksheet_SelectionChangeRioran
Сообщение отредактировал Rioran - Четверг, 05.06.2014, 17:22
Rioran Проблема вот в чем. У меня при помощи макроса, который прописан в модуле, из ячеек A1:A20 (условно) копируются и вставляются в ячейки B1:B20 (условно) данные. Нужно, чтобы в B21 прописывалась дата и время вставки. Вот если руками менять данные в строке, на которую ссылается Ваш или Karbofox`а макрос - то всё ок, дата и время прописываются ниже. А если эти данные вставляются при помощи макроса - то VBA ругается.
Rioran Проблема вот в чем. У меня при помощи макроса, который прописан в модуле, из ячеек A1:A20 (условно) копируются и вставляются в ячейки B1:B20 (условно) данные. Нужно, чтобы в B21 прописывалась дата и время вставки. Вот если руками менять данные в строке, на которую ссылается Ваш или Karbofox`а макрос - то всё ок, дата и время прописываются ниже. А если эти данные вставляются при помощи макроса - то VBA ругается.ArkaIIIa
Сообщение отредактировал ArkaIIIa - Четверг, 05.06.2014, 17:32
Rioran Я думал, что макросу все равно, каким образом вносятся изменения в ячейку, и важен сам факт изменения. Но, выходит, что это не так. Почему-то конфликтуют макросы.
Rioran Я думал, что макросу все равно, каким образом вносятся изменения в ячейку, и важен сам факт изменения. Но, выходит, что это не так. Почему-то конфликтуют макросы.ArkaIIIa
Сообщение отредактировал ArkaIIIa - Четверг, 05.06.2014, 17:30
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 В общем, если на живом примере, то вот это в модуле:
[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 строке тех столбцов, куда вставляются данные, указывалась дата и время этой вставки.ArkaIIIa
ArkaIIIa, Вам нужно чтобы одновременно менялось сразу два значения?
В следующем примере макросы уже, возможно, лишнее и разумнее было бы воспользоваться поиском максимального значения, но машина запущена и сделано макросом, посмотрите =)
ArkaIIIa, Вам нужно чтобы одновременно менялось сразу два значения?
В следующем примере макросы уже, возможно, лишнее и разумнее было бы воспользоваться поиском максимального значения, но машина запущена и сделано макросом, посмотрите =)Rioran
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] , чтобы после вставки значений, строчкой ниже указывалась дата/время вставки?
Извиняюсь, что, возможно, как-то не так изначально сформулировал задачу и большое спасибо за попытку помочь.
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
Сообщение отредактировал ArkaIIIa - Пятница, 06.06.2014, 08:11
Попробовал смоделировать ситуацию на новом пустом файле. Использовал макрос: [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]
Попробовал смоделировать ситуацию на новом пустом файле. Использовал макрос: [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]
В области А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, я попробовал кардинально другой подход.
В области А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
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, и при вставке руками - все нормально работает. А вот, когда юзаю макрос вставки - беда.
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
Rioran Нет, Вы знаете, видимо конфликт не с макросом вставки. Попробовал сделать на новом файле - все нормально работает. Сейчас более расширенный пример попробую сделать и закинуть.
Rioran Нет, Вы знаете, видимо конфликт не с макросом вставки. Попробовал сделать на новом файле - все нормально работает. Сейчас более расширенный пример попробую сделать и закинуть.ArkaIIIa
Rioran Прикладываю файл. Голова кругом идет, не знаю, с чем связана ошибка :-( Попробую еще раз по порядку описать ситуацию на примере файла из приложения.
- Есть файл (файл из приложения), в котороый по связям из другого файла подтягиваются данные. Файл исходник обновляется автоматически каждые полчаса. Таким образом, при каждом обновлении файла из примера раз в полчаса - он подтягивает обновленные данные. - Есть 2 макроса, засунутых в один модуль: Первый: [vba]
[/vba] Прописывает в ячейку K27 время последнего обновления файла-исходника, откуда тянутся данные в файл-пример. Второй: [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 End Sub
[/vba] Берет данные из ячеек столбца B3:B140, смотрит значение времени, указанное в ячейке B1, находит в строке 2 аналогичное время, и вставляет скопированные данные. - Нужен третий макрос, который указывал бы строчкой ниже вставленных данных (т.е. 141-ой), дату и время этой вставки.
Ваш макрос (условно назовем его Макрос № 3) работает: - Если копировать-вставлять руками - Если копировать-вставлять макросом вставки (№2, из описания выше) - Но вот если задействовано все 3 макроса - то возникает сообщение: Run-time Error 1004: Method `Intersect` of object`_Global`failed
Я не понимаю, на каком этапе возникает конфликт :-(
Rioran Прикладываю файл. Голова кругом идет, не знаю, с чем связана ошибка :-( Попробую еще раз по порядку описать ситуацию на примере файла из приложения.
- Есть файл (файл из приложения), в котороый по связям из другого файла подтягиваются данные. Файл исходник обновляется автоматически каждые полчаса. Таким образом, при каждом обновлении файла из примера раз в полчаса - он подтягивает обновленные данные. - Есть 2 макроса, засунутых в один модуль: Первый: [vba]
[/vba] Прописывает в ячейку K27 время последнего обновления файла-исходника, откуда тянутся данные в файл-пример. Второй: [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 End Sub
[/vba] Берет данные из ячеек столбца B3:B140, смотрит значение времени, указанное в ячейке B1, находит в строке 2 аналогичное время, и вставляет скопированные данные. - Нужен третий макрос, который указывал бы строчкой ниже вставленных данных (т.е. 141-ой), дату и время этой вставки.
Ваш макрос (условно назовем его Макрос № 3) работает: - Если копировать-вставлять руками - Если копировать-вставлять макросом вставки (№2, из описания выше) - Но вот если задействовано все 3 макроса - то возникает сообщение: Run-time Error 1004: Method `Intersect` of object`_Global`failed
Я не понимаю, на каком этапе возникает конфликт :-(ArkaIIIa
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
