Здравствуйте! Помогите, пожалуйста доработать код. Необходимо, чтобы при заполнении ячеек столбца B, в столбце А автоматически проставлялась дата. При этом дата не должна меняться. У меня получилось следующее [vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) On Error GoTo A If Not Intersect(Target, [b2:b100]) Is Nothing Then Target.Offset(, -1) = Now With Target.Offset(, -1).Resize(, 2).Validation .Delete .Add Type:=xlValidateCustom, AlertStyle:=xlValidAlertStop, Operator:= _ xlBetween, Formula1:="=A3<>A3" .IgnoreBlank = True .InCellDropdown = True .InputTitle = "" .ErrorTitle = " Не менять" .InputMessage = "" .ErrorMessage = "Изменение даты не возможно!" .ShowInput = True .ShowError = True End With End If A: Exit Sub End Sub
[/vba] Проблема в том, что первые строки столбцов A и B являются заголовками таблицы, необходимо,чтобы код начинал срабатывать, начиная со второй строчки. В моём варианте получается, что макрос срабатывает, во всём диапазоне столбцов A и B. Знающие люди, подскажите пожалуйста, в чём проблема? Изучаю VBA не давно, опыта нет ещё
Здравствуйте! Помогите, пожалуйста доработать код. Необходимо, чтобы при заполнении ячеек столбца B, в столбце А автоматически проставлялась дата. При этом дата не должна меняться. У меня получилось следующее [vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) On Error GoTo A If Not Intersect(Target, [b2:b100]) Is Nothing Then Target.Offset(, -1) = Now With Target.Offset(, -1).Resize(, 2).Validation .Delete .Add Type:=xlValidateCustom, AlertStyle:=xlValidAlertStop, Operator:= _ xlBetween, Formula1:="=A3<>A3" .IgnoreBlank = True .InCellDropdown = True .InputTitle = "" .ErrorTitle = " Не менять" .InputMessage = "" .ErrorMessage = "Изменение даты не возможно!" .ShowInput = True .ShowError = True End With End If A: Exit Sub End Sub
[/vba] Проблема в том, что первые строки столбцов A и B являются заголовками таблицы, необходимо,чтобы код начинал срабатывать, начиная со второй строчки. В моём варианте получается, что макрос срабатывает, во всём диапазоне столбцов A и B. Знающие люди, подскажите пожалуйста, в чём проблема? Изучаю VBA не давно, опыта нет ещё gredd
gredd, макрос срабатывает при любом изменении на листе Лист1, но обработка происходит, только если изменение произошло в B2:B100. Я не обнаружил проблемы, о которой Вы пишите.
gredd, макрос срабатывает при любом изменении на листе Лист1, но обработка происходит, только если изменение произошло в B2:B100. Я не обнаружил проблемы, о которой Вы пишите.Karataev
Karataev, проблема в том, что необходимо, чтобы дата не менялась и посторонний пользователь не мог бы её вообще никак изменить. Мне нужно в первой строке столбца А прописать название таблицы, а макрос не даёт этого сделать( И дата меняется при изменении значений в столбце B. Подскажите как это исправить, пожалуйста
Karataev, проблема в том, что необходимо, чтобы дата не менялась и посторонний пользователь не мог бы её вообще никак изменить. Мне нужно в первой строке столбца А прописать название таблицы, а макрос не даёт этого сделать( И дата меняется при изменении значений в столбце B. Подскажите как это исправить, пожалуйста gredd
А вот так если? Кстати, работает и для множественного одновременного ввода (или через Контрл Ентер, или через вставку) [vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, [B2:B100]) Is Nothing Then n_ = Intersect(Target, [B2:B100]).Cells.Count Application.EnableEvents = 0 For i = 1 To n_ If Intersect(Target, [B2:B100])(i).Offset(, -1) = "" Then Intersect(Target, [B2:B100])(i).Offset(, -1) = Now End If Next i Intersect(Target, [B2:B100]).Offset(, -1).NumberFormat = "dd/mm/yy h:mm" Application.EnableEvents = 1 End If End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Not Intersect(Target, [A2:A100]) Is Nothing Then Target(1).Offset(, 1).Select End If End Sub
[/vba]
А вот так если? Кстати, работает и для множественного одновременного ввода (или через Контрл Ентер, или через вставку) [vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, [B2:B100]) Is Nothing Then n_ = Intersect(Target, [B2:B100]).Cells.Count Application.EnableEvents = 0 For i = 1 To n_ If Intersect(Target, [B2:B100])(i).Offset(, -1) = "" Then Intersect(Target, [B2:B100])(i).Offset(, -1) = Now End If Next i Intersect(Target, [B2:B100]).Offset(, -1).NumberFormat = "dd/mm/yy h:mm" Application.EnableEvents = 1 End If End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Not Intersect(Target, [A2:A100]) Is Nothing Then Target(1).Offset(, 1).Select End If End Sub