Страницы: 1
RSS
Объединить команды внутри одной процедуры "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

 
Проверяйте
Скрытый текст
Согласие есть продукт при полном непротивлении сторон
 
Все работает!
Огромное спасибо, Sanja!!!
Страницы: 1
Наверх