Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, [D2:D125]) Is Nothing Then Application.EnableEvents = False If Left(Target, 1) Like "[с д а]" Then Else MsgBox "Ставятся только буквы с -Сысерть; д -Дегтярск; а-Аша." Target.Activate: Target = "" End If Application.EnableEvents = True End If End Sub
[/vba]
Все работает, но не знаю как добавить сюда еще столбцы F,H,J,L,N,P Пробовал копировать его но тогда не работает.
Доброго времени суток. Помогите с макросом.
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, [D2:D125]) Is Nothing Then Application.EnableEvents = False If Left(Target, 1) Like "[с д а]" Then Else MsgBox "Ставятся только буквы с -Сысерть; д -Дегтярск; а-Аша." Target.Activate: Target = "" End If Application.EnableEvents = True End If End Sub
[/vba]
Все работает, но не знаю как добавить сюда еще столбцы F,H,J,L,N,P Пробовал копировать его но тогда не работает.roman66rus
Private Sub Worksheet_Change(ByVal Target As Range) Dim rng1 As Range
Set rng1 = Range("D2:D125,F2:F125,H2:H125,J2:J125,L2:L125,N2:N125,P2:P125")
If Not Intersect(Target, rng1) Is Nothing Then Application.EnableEvents = False If Left(Target, 1) Like "[с д а]" Then Else MsgBox "Ставятся только буквы с -Сысепть; д -Дефтяпск; а-Аша." Target.Activate: Target = "" End If Application.EnableEvents = True End If End Sub
[/vba]
Просто диапазон прописать надо [vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) Dim rng1 As Range
Set rng1 = Range("D2:D125,F2:F125,H2:H125,J2:J125,L2:L125,N2:N125,P2:P125")
If Not Intersect(Target, rng1) Is Nothing Then Application.EnableEvents = False If Left(Target, 1) Like "[с д а]" Then Else MsgBox "Ставятся только буквы с -Сысепть; д -Дефтяпск; а-Аша." Target.Activate: Target = "" End If Application.EnableEvents = True End If End Sub