Вставил разработанный Вами макрос в свой код, так же создал модуль 1 и вставил в него Ваш код. Если оставляю один Ваш макрос без моих, то все работает, только функция ErrStreetNum=() в диспетчере имен не показывает выделенную ячейку.
Вот общий код, подскажите что не так, пожалуйста:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = [Ãîðîä].Address Then [Ðàéîí] = "": Exit Sub
Dim Rng As Range, x As Range, v$
Set Rng = Intersect(Target, Range("H2:H1001"))
If Rng Is Nothing Then Exit Sub
On Error GoTo exit_
Application.EnableEvents = False
For Each x In Rng
With x
If ErrStreetNum(.Value) Then
.Select
MsgBox "Ïðèìåðû ïðàâèëüíûõ íîìåðîâ óëèö:" & vbLf & vbLf & "1234" & vbLf & "1234á" & vbLf & "1234á/567" & vbLf & "1234á/567ã", vbCritical, "Îøèáêà ââîäà!"
v = .Value
Application.Undo
Application.SendKeys v & "{F2}", True
End If
End With
Next
exit_:
Application.CutCopyMode = False
Application.EnableEvents = True
If Err Then MsgBox Err.Description, vbCritical, "Îøèáêà"
Exit Sub
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("B2:B1001")) Is Nothing Then
If Target = "" Then
With Target.Offset(0, 1).Validation
.Delete
End With
Target.Offset(0, 1).ClearContents
Else
With Target.Offset(0, 1).Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=$AT$2:$AT$11"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
End If
End If
If Intersect(Target, Range("B2:B1001")) Is Nothing Then Exit Sub
On Error GoTo exit_
With Sheets("Table_MSSQL")
If .Cells(Target.Row, "E") <> "" Then
Application.EnableEvents = False
.Cells(Target.Row, "C").Value = Now
.Cells(Target.Row, "C").EntireColumn.AutoFit
Else
.Cells(Target.Row, "C").Value = Empty
End If
End With
exit_:
Application.EnableEvents = True
Exit Sub
On Error Resume Next
If Target.Value = x Then Exit Sub
Select Case Target(1, 1).Address
Case [Êîë.êîì.îò2].Address: [Êîë.êîì.äî2].Value = ""
End Select
End Sub
