Страницы: 1
RSS
Подстановка неизменяющейся даты
 
Добрый день! Нужен совет! При вводе в столбец А данных автоматически напротив в столбце В проставляется дата сегодняшняя. Как сделать чтобы эта дата не менялась когда завтра я открою книгу. Пример прикреплен
 
Здравия.
Цитата
VB777 написал: Как сделать
Макросом, если устроит.

Формула массива (ФМ) вводится Ctrl+Shift+Enter
Memento mori
 
Конечно устроит. А как)?
 
В модуль листа:
Код
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Columns(1).Resize(Rows.Count - 1).Offset(1), Target) Is Nothing Then
        Application.EnableEvents = False
        Target.Offset(, 1).Value = Date
        Application.EnableEvents = True
    End If
End Sub
Когда вводите данные в 1м столбце, то дата правее макросом ставится как значение.

Формула массива (ФМ) вводится Ctrl+Shift+Enter
Memento mori
 
Код в модуль листа файл сохранить в формате xlsm
Код
Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Range("A2:A999"), Target) Is Nothing Then Exit Sub
    Target.Offset(0, 1) = IIf(Target <> "", Date, "")
End Sub
Если данные в столбце А удалить, то дата сотрется.
Алексей М.
 
Если в столбец А заносятся данные вставкой из буфера обмена по несколько ячеек, то так
Код
Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Range("A2:A999"), Target) Is Nothing Then Exit Sub
    For Each iCell In Target
        iCell.Offset(0, 1) = IIf(iCell <> "", Date, "")
    Next
End Sub
Алексей М.
 
У меня уже в
Код
Private Sub Worksheet_Change(ByVal Target As Range)
есть код
Код
Private Sub Worksheet_Change(ByVal Target As Range)
 
    If Not Intersect(Target, Range("A4:I6")) Is Nothing Then
        On Error Resume Next
        ActiveSheet.ShowAllData
        Range("A8").CurrentRegion.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Range("A3").CurrentRegion
    End If
 
 
    If Intersect(Range("B9:B2005"), Target) Is Nothing Then Exit Sub
    Target.Offset(0, 1) = IIf(Target <> "", Date, "")
    
End Sub

и выдает на строку
Код
  If Intersect(Range("B9:B2005"), Target) Is Nothing Then Exit Sub

ошибку.

 
Почему то когда я вставляю код даже на пустую книгу у меня код не сохраняет
Изменено: VB777 - 13.05.2017 10:10:24 (Дополнил скриншотом)
 
VB777, в файлах формата .xlsx макросы НЕ сохраняются. Поменяйте формат на один из перечисленных:
.xlsm
.xlsb
.xls
Только НЕ меняйте расширение файла вручную, а сделайте сохранить как и выберите формат с поддержкой макросов.

Формула массива (ФМ) вводится Ctrl+Shift+Enter
Memento mori
 
Да спасибо за замечание с расширением, но это не помогло. Все равно на код
Код
Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Range("A2:A999"), Target) Is Nothing Then Exit Sub
    Target.Offset(0, 1) = IIf(Target <> "", Date, "")
End Sub
выделяет красной строкой и естественно код не работает. Может быть кто нибудь еще посоветует код чтобы при подстановке значения напротив проставлялась текущая дата. Но самое главное чтобы эта дата завтра не поменялась.
 
Вторая и третья строка в коде с отступом.
В вашем файле отступ сделан из нескольких пробелов.
Удалите пробелы. Отступ сделайте клавишей Tab (-->|)
После замены отступов ошибка пропала.
Я впервые с таким столкнулся, правда пробелами никогда отступы не делал.
Алексей М.
 
Цитата
Не рекомендуется
   4.1. Создавать одинаковые темы или сообщения в разных форумах (cross-posting). Публикуя один и тот же вопрос в разных форумах и на дружественных сайтах вы заставляете сразу нескольких людей параллельно думать над вашей задачей и обесцениваете усилия тех, кто даст ответ вторым-третьим и т.д.
 
Убрал пробелы перед строчками и все получилось. Спасибо огромное
Изменено: VB777 - 14.05.2017 11:20:38 (Загрузка файла)
Страницы: 1
Наверх