Здравствуйте, уважаемый ZVI!  
 
Ранее Вами был реализован метод проверки корректности ввода номера дома по маске:  
1. Число от 1 до 9999  
2. Число от 1 до 9999 и РусскаяБуква  
3. Число от 1 до 9999 и РусскаяБуква и символ / c числом от 1 до 999  
4. Число от 1 до 9999 и РусскаяБуква и символ / c числом от 1 до 999 и РусскаяБуква  
 
Прошу Вас добавить к разработанному ранее регулярному выражению "^([1-9]\d{0,3}[А-яЁё]?|[1-9]\d{0,3}[А-яЁё]/[1-9]\d{0,2}[А-яЁё]?)$" маску:
5. Число от 1 до 9999 и символ / c числом от 1 до 999.  
6. Число от 1 до 9999 и символ / c числом от 1 до 999 и РусскаяБуква.  
 
Спасибо!

Спасибо, ZVI. Где найти Ваши контакты для личного разговора?

Вставил разработанный Вами макрос в свой код, так же создал модуль 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

Именно! У вас талант! Только как мне ее привинтить к своему файлу?

Спасибо, но не проходит...

Здравствуйте, ZVI! Спасибо. Идея хороша и работает, но ее бы доработать, чтобы Excel выдавал ошибку и не пропускал значения, которые не соответствуют заданным условиям.

А почему в таком виде не работает все, что ниже If Target.Address = [Тип сделки].Address Then [Количество.комнат] = "": Exit Sub?
 
Private Sub Worksheet_Change(ByVal Target As Range)  
   If Target.Address = [Город].Address Then [Район] = "": Exit Sub
   If Target.Address = [Тип сделки].Address Then [Количество.комнат] = "": Exit Sub
   If Target.Address = [Тип.сделки].Address Then [Регион] = "": 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  
   
End Sub

Доковырялся до истины этого тренда года - скрытие текста при помощи условного форматирования, на мой взгляд, вовсе не является обнулением содержимого ячейки, поскольку формула, ссылающаяся на эту ячейку все равно видит ее содержимое. Это просто скрытие текста от пользователя, но не обнуление.

Спасибо)

Уважаемый Kim, все сейчас заметил, что не работает ввод номера 1, 2, 10 и т.д.  
Не могли бы поправить?

{quote}{login=EducatedFool}{date=11.01.2012 11:29}{thema=}{post}  
Надо совместить 2 макроса:  
{/post}{/quote}  
 
Снова та же проблема. Только теперь с тремя макросами. Два верхних работают, нижний отказывается автоматически ставить и удалять дату.  
 
Private Sub Worksheet_Change(ByVal Target As Range)  
   If Target.Address = [Ãîðîä].Address Then [Ðàéîí] = "": Exit Sub
     
   If Target.Cells.Count > 1 Then Exit Sub  
   If Not Intersect(Target, Range("B2")) 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:="=$AS$2:$AS$11"  
               .IgnoreBlank = True  
               .InCellDropdown = True  
               .InputTitle = ""  
               .ErrorTitle = ""  
               .InputMessage = ""  
               .ErrorMessage = ""  
               .ShowInput = True  
               .ShowError = True  
           End With  
       End If  
   End If  
Exit Sub  
     
   If Target.Cells.Count > 1 Then Exit Sub  
      If Intersect(Target, Range("B2:B2000")) 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  
End Sub

Вы волшебник, Kim) Впрочем, как и все эксперты данного портала! Кланяюсь перед Вами!

И как это сделать в своем файле? ) Столбец B скрыт...

Вы правы, ребята, я не совсем точно написал условие. Впредь Ваши замечания учту.  
Уважаемый Kim, Вы сделали почти все так, как надо, кроме следующего: не проходят значения, где перед слэшем всего одна или две цифры, и одна или две после него. Значения вида 1/111, 11/111а, 11а/1 работают.  
Спасибо.

А почему нет? Там же написано - "разрешено", то есть разрешено до 4-х цифр и одна буква до слэша и до 3-х цифр и одна буква после слэша

{quote}{login=kim}{date=12.01.2012 09:45}{thema=}{post}Попробуйте что-нибудь ввести в желтом диапазоне...{/post}{/quote}  
 
Поразительно! Вы близки к цели! Но есть маленькие неточности - не проходят следующие случаи ввода данных:  
11/1  
11/11  
111/111  
1111/1  
1111/11  
1111/111  
1111а/1  
1111/1а  
и подобные им.    
А, например, 1111а/11а или 11а/1б проходит.  
 
Посмотрите еще, пожалуйста, если есть время на это.

{quote}{login=kim}{date=12.01.2012 09:27}{thema=}{post}Saeglopur, Вы бы лучше сказали, прав я или нет? Или существует определенная жесткая маска данных (по количеству символов)?{/post}{/quote}  
 
Нет, Вы правильно заметили, что жесткая маска отсутствует. Это же номер дома, он может быть любым в указанных пределах - от 1в до 1132а/102б

{quote}{login=kim}{date=12.01.2012 09:11}{thema=}{post}Не, автор сказал "цифр до слэша должно быть не более 4" значит может быть менее :)  
Формулу я накалякал только в проверке данных она не отрабатывает :((только на листе) Подумаю еще...{/post}{/quote}  
 
Да, не все так просто в реализации оказалось, как хотелось бы. Но все равно, спасибо!

Спасибо, но что-то не получается... Возникает ошибка, пишет. У меня данная формула предусматривается в ячейке H2. Пробовал и в А1, все равно возникает ошибка при вычислении.

Огромное спасибо, добрый человек)

Здравствуйте!  
 
Есть два макроса на одном листе - один автоматически добавляет время в определенный диапазон на второй лист, второй служит для обнуления зависимого списка.  
Вставил оба макроса на лист, но почему-то они вместе не работают. По отдельности все работает, вместе ни в какую.  
Макросы:  
 
Private Sub Worksheet_Change(ByVal Target As Range)  
   If Target.Cells.Count > 1 Then Exit Sub  
   If Intersect(Target, Range("B2:B2000")) 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  
 End If  
End Sub  
Private Sub Worksheet_Change(ByVal Target As Range)  
If Target.Address = [Ãîðîä].Address Then
   [Ðàéîí] = ""
  End If  
End Sub  
 
Что не так?

{quote}{login=kim}{date=09.09.2010 09:25}{thema=}{post}Сейчас, использование летучей ДВССЫЛ(), уже не модно.  
Во вложении два варианта зависимых списков.  
Вопрос с "обнулением" тоже решен.{/post}{/quote}  
 
Здравствуйте! Пробовал привинтить к своему файлу ваши модные фишки, но почему-то оба способа не позволяют зависимому списку обнуляться при выборе в ведущем списке другого значения. В остальном способы рабочие. В чем может быть причина?

Здравствуйте!  
 
Как задать последовательность/порядок ввода номера дома/строения в ячейку? Порядок таков, разрешено: до четырех цифр, затем буква (русский алфавит "а-я"), далее правый слэш "/", затем три цифры и одна буква (так же "а-я") - "1111а/111б".

{quote}{login=}{date=08.01.2012 12:54}{thema=}{post}поправил{/post}{/quote}  
 
Отлично! Огромное спасибо! Мне бы Ваши знания и возможности ;)

Ребята, в названии ваших правил четко и по-русски написано - ознакомиться перед созданием новых тем )) Я не создавал тему, а воспользовался существующей. Не горячитесь) Поберегите нервы.  
 
Сейчас сделаю точный пример.    
Спасибо.

{quote}{login=}{date=07.01.2012 11:59}{thema=}{post}ну, какой пример, такой и макрос. Был бы другой пример, был бы другой макрос.  
 
 
P.S. У меня такое чувство, что кто-то насильно заставляет людей делать ненужные примеры и выкладывать их на форум, а мы тут сидим глупые, и понять не можем, что им надо{/post}{/quote}  
 
) Мне, как человеку не соображающему в VB, было невдомек, что приведенный пример на одном листе, приведет к некорректному написанию макроса Вами.  
Файл-оригинал, в который нужно вставить этот макрос - велик по размеру. Но придется прикрепить теперь.  
 
Маленькое пояснение: автоматически вставить дату надо в диапазон ячеек С2:C1001 на лист "Table_MSSQL" при заполненном диапазоне ячеек D1:D1001, которые заполняются заданными данными при условии заполнения диапазона ячеек E2:E1001, которые, в свою очередь, заполняются данными из диапазона ячеек B2:B1001 с листа Таблица_объявлений.  
 
Подробно можно увидеть в прикрепляемом файле.  
<EM><STRONG>Файл удален</STRONG> - велик размер - [<STRONG>МОДЕРАТОРЫ</STRONG>]</EM>

Только как теперь привязать этот макрос в свой файл, где аналог ячейки B4 находится на Листе 1, а аналоги ячеек E4 и F4 на Листе 2?

Все работает! Спасибо! :)

Юрий М, Вы попросили пример, я его быстро набросал :)  
 
На деле в файле 1000 ячеек, в которые из подставляются данные из других ячеек, а не вводятся туда вручную. Отследить ввод данных в каждую из них - нереально.  
Такого пояснения достаточно?

Пример