Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel (архив)
Страницы: 1
RSS
Два макроса на одном листе книги Excel
 
#1
11.01.2012 23:25:30
Здравствуйте!  
 
Есть два макроса на одном листе - один автоматически добавляет время в определенный диапазон на второй лист, второй служит для обнуления зависимого списка.  
Вставил оба макроса на лист, но почему-то они вместе не работают. По отдельности все работает, вместе ни в какую.  
Макросы:  
 
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  
 
Что не так?
 
 
 
#2
11.01.2012 23:29:25
2 макроса с одним именем недопустимы.  
 
Надо совместить 2 макроса:  
 
Private Sub Worksheet_Change(ByVal Target As Range)  
   If Target.Address = [Район].Address Then [Район] = "": 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
Надстройки для Excel  Парсинг сайтов  Мониторинг цен конкурентов
 
 
 
#3
11.01.2012 23:36:45
Огромное спасибо, добрый человек)
 
 
 
#4
13.01.2012 01:08:06
{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
 
 
 
#5
13.01.2012 03:38:05
Макрос один (как три тополя на Плющихе).  
По существу:  
1. В конце второго блока exit sub убрать;  
2. Убрать в начале последнего блока If Target.Cells.Count > 1 Then Exit Sub т.к. эта проверка уже была в начале второго блока.
 
 
 
#6
15.01.2012 18:22:04
Спасибо)
 
 
 
#7
15.01.2012 19:17:32
А почему в таком виде не работает все, что ниже 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
 
 
 
#8
16.01.2012 03:53:34
Вероятно потому, что это условие (If Target.Address = [Тип сделки].Address)соблюдено и происходит выход (Exit Sub) из процедуры.
 
 
 
#9
16.01.2012 04:03:24
Попробуйте заменить:  
If Target.Address = [Тип сделки].Address Then [Количество.комнат] = "": Exit Sub
If Target.Address = [Тип.сделки].Address Then [Регион] = "": Exit Sub
 
на:  
If Target.Address = [Тип сделки].Address Then
[Количество.комнат] = ""
[Регион] = ""
Exit Sub 'если выход не нужен, эту строку убрать  
End if
 
 
 
#10
16.01.2012 21:42:27
Спасибо, но не проходит...
 
 
 
Страницы: 1
Читают тему
Наверх