Всем привет! Вопрос очень простой, но, увы, я профан в этом, но по работе нужно сделать! Поэтому обращаюсь к вам. Как правильно соединить два макроса в исходном тексте листа:
[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]
Второй позволяет в одну ячейку выбирать несколько вариантов из выпадающего списка!
Всем привет! Вопрос очень простой, но, увы, я профан в этом, но по работе нужно сделать! Поэтому обращаюсь к вам. Как правильно соединить два макроса в исходном тексте листа:
[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
Сообщение отредактировал DJ_Marker_MC - Четверг, 28.05.2015, 16:09
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]
А что мешает сделать это "в лоб"? [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