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] Как добавить в этот макрос, чтобы при вставке он ниже (в 141 строке) указывал время вставки?
Может попробовать зайти с другой стороны? [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] Как добавить в этот макрос, чтобы при вставке он ниже (в 141 строке) указывал время вставки?ArkaIIIa
ArkaIIIa, как раз ходил обедать и понял, что надо делать также =) У форумчан и мысли сходятся. Щас подумаем.
*****
Переделал Ваш макрос, попробуйте с моим файлом - примером. Сработает даже если область вставки будет на несколько столбцов.
Довольно занятно получилось, что мы топтались вокруг да около, а дело решалось простым OFFSET =)
[vba]
Код
Sub Tester()
Dim R As Range Dim rngX As Range Dim X As Integer
Set R = Sheets(7).Rows(2).Find(Sheets(7).[B1].Text, , xlValues, xlWhole) Set rngX = Sheets(7).[B3:B140]
If Not R Is Nothing Then rngX.Copy R.Offset(1).PasteSpecial Paste:=xlPasteValues Set rngX = Selection For X = 1 To rngX.Columns.Count rngX.Cells(1, X).Offset(141 - rngX.Cells(1, X).Row).Value = Now Next X End If
End Sub
[/vba]
ArkaIIIa, как раз ходил обедать и понял, что надо делать также =) У форумчан и мысли сходятся. Щас подумаем.
*****
Переделал Ваш макрос, попробуйте с моим файлом - примером. Сработает даже если область вставки будет на несколько столбцов.
Довольно занятно получилось, что мы топтались вокруг да около, а дело решалось простым OFFSET =)
[vba]
Код
Sub Tester()
Dim R As Range Dim rngX As Range Dim X As Integer
Set R = Sheets(7).Rows(2).Find(Sheets(7).[B1].Text, , xlValues, xlWhole) Set rngX = Sheets(7).[B3:B140]
If Not R Is Nothing Then rngX.Copy R.Offset(1).PasteSpecial Paste:=xlPasteValues Set rngX = Selection For X = 1 To rngX.Columns.Count rngX.Cells(1, X).Offset(141 - rngX.Cells(1, X).Row).Value = Now Next X End If
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 Dim rngX As Range Dim X As Integer
Set R = Sheets(7).Rows(2).Find(Sheets(7).[B1].Text, , xlValues, xlWhole) Set rngX = Sheets(7).[B3:B140]
If Not R Is Nothing Then rngX.Copy R.Offset(1).PasteSpecial Paste:=xlPasteValues Set rngX = Selection For X = 1 To rngX.Columns.Count rngX.Cells(1, X).Offset(141 - rngX.Cells(1, X).Row).Value = Now Next X End If End Sub
[/vba]
Как то не так совместил?
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 Dim rngX As Range Dim X As Integer
Set R = Sheets(7).Rows(2).Find(Sheets(7).[B1].Text, , xlValues, xlWhole) Set rngX = Sheets(7).[B3:B140]
If Not R Is Nothing Then rngX.Copy R.Offset(1).PasteSpecial Paste:=xlPasteValues Set rngX = Selection For X = 1 To rngX.Columns.Count rngX.Cells(1, X).Offset(141 - rngX.Cells(1, X).Row).Value = Now Next X End If End Sub
[/vba] RAN, сначала rngX используется для копирования изначального диапазона, а этой фразой я превращаю его (пытаюсь, во всяком случае ^^) в область вставки, закрепляя за новым листом, где он ранее был вставлен.
ArkaIIIa, имел в виду:
[vba]
Код
Sheets(7).Select
[/vba] RAN, сначала rngX используется для копирования изначального диапазона, а этой фразой я превращаю его (пытаюсь, во всяком случае ^^) в область вставки, закрепляя за новым листом, где он ранее был вставлен.Rioran
Добрый день! помогите, пожалуйста, использую для записи времени изменения ячейки данный код (ниже, давно где то нашел), но теперь структура файла поменялась, и та ячейка, данные в которую вносились вручную, стала меняться формулой и соответственно данный код уже не работает. Понимаю, что надо использовать Calculate, но ума не хватает чтобы новый код работал так же. Помогите пожалуйста написать код, пример в файле т.е. в примере: при любом изменении в столбце L в конкретной ячейке - должно проставляться время в ячейке справа
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) If Target.Cells.Count > 1 Then Exit Sub If Not Intersect(Target, Range("L2:L100")) Is Nothing Then With Target(1, 2) .Value = Now .EntireColumn.AutoFit End With End If End Sub
[/vba]
Добрый день! помогите, пожалуйста, использую для записи времени изменения ячейки данный код (ниже, давно где то нашел), но теперь структура файла поменялась, и та ячейка, данные в которую вносились вручную, стала меняться формулой и соответственно данный код уже не работает. Понимаю, что надо использовать Calculate, но ума не хватает чтобы новый код работал так же. Помогите пожалуйста написать код, пример в файле т.е. в примере: при любом изменении в столбце L в конкретной ячейке - должно проставляться время в ячейке справа
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) If Target.Cells.Count > 1 Then Exit Sub If Not Intersect(Target, Range("L2:L100")) Is Nothing Then With Target(1, 2) .Value = Now .EntireColumn.AutoFit End With End If End Sub
Добрые люди!помогите мне [moder]Мы не добрые. Мы справедливые. За каким Вы в чужую тему залезли со своим вопросом? Читайте Правила форума. Эта тема закрыта.
Добрые люди!помогите мне [moder]Мы не добрые. Мы справедливые. За каким Вы в чужую тему залезли со своим вопросом? Читайте Правила форума. Эта тема закрыта.Igrik555
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
