Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Соединить два макроса - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Соединить два макроса (Макросы/Sub)
Соединить два макроса
Tepliy Дата: Четверг, 28.05.2015, 15:32 | Сообщение № 1
Группа: Пользователи
Ранг: Новичок
Сообщений: 16
Репутация: 0 ±
Замечаний: 20% ±

Excel 2013
Всем привет! Вопрос очень простой, но, увы, я профан в этом, но по работе нужно сделать! Поэтому обращаюсь к вам.
Как правильно соединить два макроса в исходном тексте листа:

[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A2:AA5")) Is Nothing Then
On Error Resume Next
ActiveSheet.ShowAllData
Range("A7").CurrentRegion.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Range("A1").CurrentRegion
End If
End Sub
[/vba]

Первый макрос нужен для фильрации данных в таблице по вводимым.

[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Not Intersect(Target, Range("C2:C5")) Is Nothing And Target.Cells.Count = 1 Then
Application.EnableEvents = False
newVal = Target
Application.Undo
oldval = Target
If Len(oldval) <> 0 And oldval <> newVal Then
Target = Target & "," & newVal
Else
Target = newVal
End If
If Len(newVal) = 0 Then Target.ClearContents
Application.EnableEvents = True
End If
End Sub
[/vba]

Второй позволяет в одну ячейку выбирать несколько вариантов из выпадающего списка!


Сообщение отредактировал DJ_Marker_MC - Четверг, 28.05.2015, 16:09
 
Ответить
СообщениеВсем привет! Вопрос очень простой, но, увы, я профан в этом, но по работе нужно сделать! Поэтому обращаюсь к вам.
Как правильно соединить два макроса в исходном тексте листа:

[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A2:AA5")) Is Nothing Then
On Error Resume Next
ActiveSheet.ShowAllData
Range("A7").CurrentRegion.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Range("A1").CurrentRegion
End If
End Sub
[/vba]

Первый макрос нужен для фильрации данных в таблице по вводимым.

[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Not Intersect(Target, Range("C2:C5")) Is Nothing And Target.Cells.Count = 1 Then
Application.EnableEvents = False
newVal = Target
Application.Undo
oldval = Target
If Len(oldval) <> 0 And oldval <> newVal Then
Target = Target & "," & newVal
Else
Target = newVal
End If
If Len(newVal) = 0 Then Target.ClearContents
Application.EnableEvents = True
End If
End Sub
[/vba]

Второй позволяет в одну ячейку выбирать несколько вариантов из выпадающего списка!

Автор - Tepliy
Дата добавления - 28.05.2015 в 15:32
buchlotnik Дата: Четверг, 28.05.2015, 15:49 | Сообщение № 2
Группа: Заблокированные
Ранг: Участник клуба
Сообщений: 3442
Репутация: 929 ±
Замечаний: 20% ±

2010, 2013, 2016 RUS / ENG
А что мешает сделать это "в лоб"?
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)    
If Not Intersect(Target, Range("A2:AA5")) Is Nothing Then    
On Error Resume Next    
ActiveSheet.ShowAllData    
Range("A7").CurrentRegion.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Range("A1").CurrentRegion    
End If
If Not Intersect(Target, Range("C2:C5")) Is Nothing And Target.Cells.Count = 1 Then    
Application.EnableEvents = False    
newVal = Target    
Application.Undo    
oldval = Target    
If Len(oldval) <> 0 And oldval <> newVal Then    
Target = Target & "," & newVal    
Else    
Target = newVal    
End If    
If Len(newVal) = 0 Then Target.ClearContents    
Application.EnableEvents = True    
End If    

End Sub    
[/vba]


Сообщение отредактировал buchlotnik - Четверг, 28.05.2015, 15:50
 
Ответить
СообщениеА что мешает сделать это "в лоб"?
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)    
If Not Intersect(Target, Range("A2:AA5")) Is Nothing Then    
On Error Resume Next    
ActiveSheet.ShowAllData    
Range("A7").CurrentRegion.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Range("A1").CurrentRegion    
End If
If Not Intersect(Target, Range("C2:C5")) Is Nothing And Target.Cells.Count = 1 Then    
Application.EnableEvents = False    
newVal = Target    
Application.Undo    
oldval = Target    
If Len(oldval) <> 0 And oldval <> newVal Then    
Target = Target & "," & newVal    
Else    
Target = newVal    
End If    
If Len(newVal) = 0 Then Target.ClearContents    
Application.EnableEvents = True    
End If    

End Sub    
[/vba]

Автор - buchlotnik
Дата добавления - 28.05.2015 в 15:49
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Соединить два макроса (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!