Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Проставление текущей даты в соседнем столбце при определенно - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Проставление текущей даты в соседнем столбце при определенно (Макросы/Sub)
Проставление текущей даты в соседнем столбце при определенно
konkruk111 Дата: Четверг, 17.12.2020, 07:33 | Сообщение № 1
Группа: Пользователи
Ранг: Прохожий
Сообщений: 5
Репутация: 0 ±
Замечаний: 0% ±

2016
Всем привет, помогите дописать макрос, чтобы при выборе в 7 столбце (H) из списка значения "исполнено" или "без исполнения" в 8 столбце проставлялась дата
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.Count > 1 Then Exit Sub
    If Target.Column = 2 And Target.Row > 1 And Not IsEmpty(Target.Value) And Target.Offset(0, 1).Value = "" Then _
        Target.Offset(0, 1).Value = Date
    If Target.Column = 11 And Target.Row > 1 And Not IsEmpty(Target.Value) And Target.Offset(0, 1).Value = "" Then _
        Target.Offset(0, 1).Value = Date
    If Target.Column = 8 And Target.Row > 1 And Not IsEmpty(Target.Value) And Target.Offset(0, 1).Value = "" Then _
        Target.Offset(0, 1).Value = Date
    If Target.Column = 43 And Target.Row > 1 And Not IsEmpty(Target.Value) And Target.Offset(0, 1).Value = "" Then _
        Target.Offset(0, 1).Value = Date
     If Not Intersect(Target, Range("E2:E99999")) Is Nothing Then
       i = Split(Target.Address, "$")(2)
       LastRow = Sheets("РФ").Cells(Rows.Count, 1).End(xlUp).Row
        If InStr(Cells(i, 4), "РФ") > 0 Then
          Range("A" & CStr(i) & ":E" & i).Copy Sheets("РФ").Range("A" & LastRow + 1)
        End If
     End If
End Sub
[/vba]
К сообщению приложен файл: 0538518.xlsm (30.2 Kb)
 
Ответить
СообщениеВсем привет, помогите дописать макрос, чтобы при выборе в 7 столбце (H) из списка значения "исполнено" или "без исполнения" в 8 столбце проставлялась дата
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.Count > 1 Then Exit Sub
    If Target.Column = 2 And Target.Row > 1 And Not IsEmpty(Target.Value) And Target.Offset(0, 1).Value = "" Then _
        Target.Offset(0, 1).Value = Date
    If Target.Column = 11 And Target.Row > 1 And Not IsEmpty(Target.Value) And Target.Offset(0, 1).Value = "" Then _
        Target.Offset(0, 1).Value = Date
    If Target.Column = 8 And Target.Row > 1 And Not IsEmpty(Target.Value) And Target.Offset(0, 1).Value = "" Then _
        Target.Offset(0, 1).Value = Date
    If Target.Column = 43 And Target.Row > 1 And Not IsEmpty(Target.Value) And Target.Offset(0, 1).Value = "" Then _
        Target.Offset(0, 1).Value = Date
     If Not Intersect(Target, Range("E2:E99999")) Is Nothing Then
       i = Split(Target.Address, "$")(2)
       LastRow = Sheets("РФ").Cells(Rows.Count, 1).End(xlUp).Row
        If InStr(Cells(i, 4), "РФ") > 0 Then
          Range("A" & CStr(i) & ":E" & i).Copy Sheets("РФ").Range("A" & LastRow + 1)
        End If
     End If
End Sub
[/vba]
Автор - konkruk111
Дата добавления - 17.12.2020 в 07:33
Pelena Дата: Четверг, 17.12.2020, 07:41 | Сообщение № 2
Группа: Админы
Ранг: Местный житель
Сообщений: 19174
Репутация: 4413 ±
Замечаний: ±

Excel 365 & Mac Excel
Здравствуйте.
Допишите ещё одну строчку
[vba]
Код
    If Target.Column = 7 And Target.Row > 1 And (Target.Value="исполнено" Or  Target.Value="без исполнения") And Target.Offset(0, 1).Value = "" Then _
        Target.Offset(0, 1).Value = Date
[/vba]

"Черт возьми, Холмс! Но как??!!"
Ю-money 41001765434816
 
Ответить
СообщениеЗдравствуйте.
Допишите ещё одну строчку
[vba]
Код
    If Target.Column = 7 And Target.Row > 1 And (Target.Value="исполнено" Or  Target.Value="без исполнения") And Target.Offset(0, 1).Value = "" Then _
        Target.Offset(0, 1).Value = Date
[/vba]
Автор - Pelena
Дата добавления - 17.12.2020 в 07:41
konkruk111 Дата: Четверг, 17.12.2020, 08:07 | Сообщение № 3
Группа: Пользователи
Ранг: Прохожий
Сообщений: 5
Репутация: 0 ±
Замечаний: 0% ±

2016
Цитата Pelena, 17.12.2020 в 07:41, в сообщении № 2 ()
Здравствуйте.
Допишите ещё одну строчку
    If Target.Column = 7 And Target.Row > 1 And (Target.Value="исполнено" Or  Target.Value="без исполнения") And Target.Offset(0, 1).Value = "" Then _
        Target.Offset(0, 1).Value = Date


Попробовал, но дата проставляется при выборе любого значения, не зависимо от выбора слов "Исполнено", или "без исполнения"
Вот так получилось:

[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.Count > 1 Then Exit Sub
    If Target.Column = 2 And Target.Row > 1 And Not IsEmpty(Target.Value) And Target.Offset(0, 1).Value = "" Then _
        Target.Offset(0, 1).Value = Date
    If Target.Column = 11 And Target.Row > 1 And Not IsEmpty(Target.Value) And Target.Offset(0, 1).Value = "" Then _
        Target.Offset(0, 1).Value = Date
    If Target.Column = 8 And Target.Row > 1 And Not IsEmpty(Target.Value) And Target.Offset(0, 1).Value = "" Then _
        Target.Offset(0, 1).Value = Date
    If Target.Column = 43 And Target.Row > 1 And Not IsEmpty(Target.Value) And Target.Offset(0, 1).Value = "" Then _
        Target.Offset(0, 1).Value = Date
    If Target.Column = 7 And Target.Row > 1 And (Target.Value = "исполнено" Or Target.Value = "без исполнения") And Target.Offset(0, 1).Value = "" Then _
        Target.Offset(0, 1).Value = Date
     If Not Intersect(Target, Range("E2:E99999")) Is Nothing Then
       i = Split(Target.Address, "$")(2)
       LastRow = Sheets("РФ").Cells(Rows.Count, 1).End(xlUp).Row
        If InStr(Cells(i, 4), "РФ") > 0 Then
          Range("A" & CStr(i) & ":E" & i).Copy Sheets("РФ").Range("A" & LastRow + 1)
        End If
     End If
End Sub
[/vba]
 
Ответить
Сообщение
Цитата Pelena, 17.12.2020 в 07:41, в сообщении № 2 ()
Здравствуйте.
Допишите ещё одну строчку
    If Target.Column = 7 And Target.Row > 1 And (Target.Value="исполнено" Or  Target.Value="без исполнения") And Target.Offset(0, 1).Value = "" Then _
        Target.Offset(0, 1).Value = Date


Попробовал, но дата проставляется при выборе любого значения, не зависимо от выбора слов "Исполнено", или "без исполнения"
Вот так получилось:

[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.Count > 1 Then Exit Sub
    If Target.Column = 2 And Target.Row > 1 And Not IsEmpty(Target.Value) And Target.Offset(0, 1).Value = "" Then _
        Target.Offset(0, 1).Value = Date
    If Target.Column = 11 And Target.Row > 1 And Not IsEmpty(Target.Value) And Target.Offset(0, 1).Value = "" Then _
        Target.Offset(0, 1).Value = Date
    If Target.Column = 8 And Target.Row > 1 And Not IsEmpty(Target.Value) And Target.Offset(0, 1).Value = "" Then _
        Target.Offset(0, 1).Value = Date
    If Target.Column = 43 And Target.Row > 1 And Not IsEmpty(Target.Value) And Target.Offset(0, 1).Value = "" Then _
        Target.Offset(0, 1).Value = Date
    If Target.Column = 7 And Target.Row > 1 And (Target.Value = "исполнено" Or Target.Value = "без исполнения") And Target.Offset(0, 1).Value = "" Then _
        Target.Offset(0, 1).Value = Date
     If Not Intersect(Target, Range("E2:E99999")) Is Nothing Then
       i = Split(Target.Address, "$")(2)
       LastRow = Sheets("РФ").Cells(Rows.Count, 1).End(xlUp).Row
        If InStr(Cells(i, 4), "РФ") > 0 Then
          Range("A" & CStr(i) & ":E" & i).Copy Sheets("РФ").Range("A" & LastRow + 1)
        End If
     End If
End Sub
[/vba]
Автор - konkruk111
Дата добавления - 17.12.2020 в 08:07
Pelena Дата: Четверг, 17.12.2020, 08:11 | Сообщение № 4
Группа: Админы
Ранг: Местный житель
Сообщений: 19174
Репутация: 4413 ±
Замечаний: ±

Excel 365 & Mac Excel
Дата должна проставляться при изменении только столбца 7 или каких ещё столбцов?

"Черт возьми, Холмс! Но как??!!"
Ю-money 41001765434816
 
Ответить
СообщениеДата должна проставляться при изменении только столбца 7 или каких ещё столбцов?
Автор - Pelena
Дата добавления - 17.12.2020 в 08:11
Pelena Дата: Четверг, 17.12.2020, 08:18 | Сообщение № 5
Группа: Админы
Ранг: Местный житель
Сообщений: 19174
Репутация: 4413 ±
Замечаний: ±

Excel 365 & Mac Excel
Поверила Вам, что столбец Н седьмой, а на самом деле восьмой
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.Count > 1 Then Exit Sub
    If Target.Column = 2 And Target.Row > 1 And Not IsEmpty(Target.Value) And Target.Offset(0, 1).Value = "" Then _
        Target.Offset(0, 1).Value = Date
    If Target.Column = 11 And Target.Row > 1 And Not IsEmpty(Target.Value) And Target.Offset(0, 1).Value = "" Then _
        Target.Offset(0, 1).Value = Date
    If Target.Column = 8 And Target.Row > 1 And (Target.Value = "исполнено" Or Target.Value = "без исполнения") And Target.Offset(0, 1).Value = "" Then _
        Target.Offset(0, 1).Value = Date
    If Target.Column = 43 And Target.Row > 1 And Not IsEmpty(Target.Value) And Target.Offset(0, 1).Value = "" Then _
        Target.Offset(0, 1).Value = Date
    If Not Intersect(Target, Range("E2:E99999")) Is Nothing Then
       i = Split(Target.Address, "$")(2)
       LastRow = Sheets("РФ").Cells(Rows.Count, 1).End(xlUp).Row
        If InStr(Cells(i, 4), "РФ") > 0 Then
          Range("A" & CStr(i) & ":E" & i).Copy Sheets("РФ").Range("A" & LastRow + 1)
        End If
     End If
End Sub
[/vba]

"Черт возьми, Холмс! Но как??!!"
Ю-money 41001765434816
 
Ответить
СообщениеПоверила Вам, что столбец Н седьмой, а на самом деле восьмой
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.Count > 1 Then Exit Sub
    If Target.Column = 2 And Target.Row > 1 And Not IsEmpty(Target.Value) And Target.Offset(0, 1).Value = "" Then _
        Target.Offset(0, 1).Value = Date
    If Target.Column = 11 And Target.Row > 1 And Not IsEmpty(Target.Value) And Target.Offset(0, 1).Value = "" Then _
        Target.Offset(0, 1).Value = Date
    If Target.Column = 8 And Target.Row > 1 And (Target.Value = "исполнено" Or Target.Value = "без исполнения") And Target.Offset(0, 1).Value = "" Then _
        Target.Offset(0, 1).Value = Date
    If Target.Column = 43 And Target.Row > 1 And Not IsEmpty(Target.Value) And Target.Offset(0, 1).Value = "" Then _
        Target.Offset(0, 1).Value = Date
    If Not Intersect(Target, Range("E2:E99999")) Is Nothing Then
       i = Split(Target.Address, "$")(2)
       LastRow = Sheets("РФ").Cells(Rows.Count, 1).End(xlUp).Row
        If InStr(Cells(i, 4), "РФ") > 0 Then
          Range("A" & CStr(i) & ":E" & i).Copy Sheets("РФ").Range("A" & LastRow + 1)
        End If
     End If
End Sub
[/vba]
Автор - Pelena
Дата добавления - 17.12.2020 в 08:18
konkruk111 Дата: Четверг, 17.12.2020, 08:35 | Сообщение № 6
Группа: Пользователи
Ранг: Прохожий
Сообщений: 5
Репутация: 0 ±
Замечаний: 0% ±

2016
Цитата Pelena, 17.12.2020 в 08:18, в сообщении № 5 ()
Поверила Вам, что столбец Н седьмой, а на самом деле восьмой

о, круто - работает.
Спасибо огромное!
 
Ответить
Сообщение
Цитата Pelena, 17.12.2020 в 08:18, в сообщении № 5 ()
Поверила Вам, что столбец Н седьмой, а на самом деле восьмой

о, круто - работает.
Спасибо огромное!
Автор - konkruk111
Дата добавления - 17.12.2020 в 08:35
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Проставление текущей даты в соседнем столбце при определенно (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!