Помогите решить довольно сложную проблему. Есть таблица (приложил ниже) в которой необходимо, чтобы при заполнении ячейки в одном столбце (из выпадающего списка), в соседнюю ячейку в другом столбце проставлялось текущее время и навсегда фиксировалось.
Удалось решить эту проблему используя в меню "Исходный код" следующего кода:
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) If Target.Count > 1 Then Exit Sub If Intersect(Me.UsedRange.Columns(3), Target) Is Nothing Then Exit Sub Application.EnableEvents = False If Target = "" Then Target.Next = "" Else Target.Next = Now Application.EnableEvents = True End Sub
[/vba]
Однако, мне необходимо чтобы такое время проставлялось и фиксировалось не в одном случае, а в целых трех случаях. Это - "Поступление заявки", "Время начала" и "Время конца". Есть этот код вставить еще раз и заменить значения столбца, то ничего не работает.
Надеюсь на Вашу помощь!
P.S. Я в макросах разбираюсь плохо и код этот нашел в интернете.
Помогите решить довольно сложную проблему. Есть таблица (приложил ниже) в которой необходимо, чтобы при заполнении ячейки в одном столбце (из выпадающего списка), в соседнюю ячейку в другом столбце проставлялось текущее время и навсегда фиксировалось.
Удалось решить эту проблему используя в меню "Исходный код" следующего кода:
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) If Target.Count > 1 Then Exit Sub If Intersect(Me.UsedRange.Columns(3), Target) Is Nothing Then Exit Sub Application.EnableEvents = False If Target = "" Then Target.Next = "" Else Target.Next = Now Application.EnableEvents = True End Sub
[/vba]
Однако, мне необходимо чтобы такое время проставлялось и фиксировалось не в одном случае, а в целых трех случаях. Это - "Поступление заявки", "Время начала" и "Время конца". Есть этот код вставить еще раз и заменить значения столбца, то ничего не работает.
Надеюсь на Вашу помощь!
P.S. Я в макросах разбираюсь плохо и код этот нашел в интернете.balancea
Private Sub Worksheet_Change(ByVal Target As Range) If Target.Count > 1 Then Exit Sub If Intersect(Me.UsedRange, Me.[c:c,e:e,g:g], Target) Is Nothing Then Exit Sub Target.Next = IIf(Target = "", "", Now) End Sub
[/vba]
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) If Target.Count > 1 Then Exit Sub If Intersect(Me.UsedRange, Me.[c:c,e:e,g:g], Target) Is Nothing Then Exit Sub Target.Next = IIf(Target = "", "", Now) End Sub