Здравствуйте!
Полдня пытаюсь скомпоновать два макроса на одном листе и все счетно.
Оба функционируют на процедуре "Worksheet_Change", первый отвечает за поиск и нахождение искомого значения в диапазоне, а второй оптимизирует выпадающий список, накапливая значения в одной и той же ячейке.
Пример прилагаю.
Буду очень признателен, если поможете.
Заранее благодарю.
Полдня пытаюсь скомпоновать два макроса на одном листе и все счетно.
Оба функционируют на процедуре "Worksheet_Change", первый отвечает за поиск и нахождение искомого значения в диапазоне, а второй оптимизирует выпадающий список, накапливая значения в одной и той же ячейке.
Пример прилагаю.
Буду очень признателен, если поможете.
Заранее благодарю.
Код |
---|
Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address <> "$C$2" Then Exit Sub Res = Target Set Rng = Worksheets("îáùàÿ").Range("B7:B10000") With Rng Set MyChoice = .Find(What:=Res, LookIn:=xlValues, MatchCase:=False) If Not MyChoice Is Nothing Then Application.Goto MyChoice Else: GoTo ExitMyChoice End If End With Exit Sub ExitMyChoice: MsgBox "Could Not Find " & Res End Sub Private Sub Worksheet_Change2(ByVal Target As Range) On Error Resume Next If Not Intersect(Target, Range("D7:D10000")) 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 |