Страницы: 1
RSS
Разграничить работу двух макросов, реагирующих на одинаковое событие листа
 
Помощь нужна в объединении макросов и запуске.
Благодарю всех заинтересованы

Код
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
On Error Resume Next
If Not Intersect(Target, Range("AF3:AS2000")) Is Nothing Then
     ' здесь работа одного макроса
End If

Dim NewCellValue$, OldComment$
Dim cell As Range
     
    'если ячейка не в отслеживаемом диапазоне, то выходим
    If Intersect(Target, Range("AA2:AA2000")) Is Nothing Then Exit Sub
     
     ' здесь работа другого макроса
End Sub
 
Вы их разграничили. Если Target не в диапазоне, переход ко второму условию. Если Target не во втором диапазоне, выходим из процедуры. Так как два диапазона не пересекаются, то запуск двух макросов исключен. Видимо, ошибка в самих макросах.
Можно так (четче видно разграничение):
Код
If Not Intersect(Target, Range("AF3:AS2000, AA2:AA2000")) Is Nothing Then

А  дальше проверка. Например, в Вашем случае, можно определиться по номеру столбца:
Код
If Target.Column = 27 Then
    Call макрос2
Else
    Call макрос1
End If

Переменные можно объявлять  в начале процедуры, т.к. они откусывают память сразу, в начале работы процедуры
 
Благодарю vikttur сейчас буду разбиратся
Изменено: Ян Копко - 01.12.2020 17:51:42
 
Ян Копко,
Чего не хватало (Exit Sub в строке №6)
Лучше так
Изменено: Jack Famous - 01.12.2020 19:37:23 («Чего не хватало» лучше не смотреть)
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
Цитата
Jack Famous написал: Чего не хватало
Это не влияет на запуск второго макроса, только обрезает лишнюю проверку.

Цитата
Лучше так
В чем преимущество перед вариантом из сообщения №2?
 
Цитата
vikttur: Это не влияет на запуск второго макроса
ну как же - это ОТМЕНЯЕТ запуск второго макроса, если первое пересечение сработало  :)
Сработать ОБА пересечения не могут, а значит другого варианта не дано. Не так?…

Цитата
vikttur: В чем преимущество перед вариантом из сообщения №2?
с твоим Вить не сравнивал))
Но, если уж спросил, то на уровне вкусовщины: я бы ветку
Код
If Not Intersect(Target, Range("AF3:AS2000, AA2:AA2000")) Is Nothing Then …
заменил на отсечение проверкой
Код
If Intersect(Target, Range("AF3:AS2000, AA2:AA2000")) Is Nothing Then Exit Sub
 :)
Изменено: Jack Famous - 01.12.2020 19:33:19
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
Первое сработало, пошла проверка диапазона второго. Но он никак не может быть задействован, так как работа шла по первому диапазону. Выход из процедуры
 
Цитата
vikttur: Но он никак не может быть задействован, так как работа шла по первому диапазону. Выход из процедуры
согласен - там по исправлению исходного кода вообще глупо получается, поэтому вариант "лучше так" для примера самое то, как по мне
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
А Баба Яга против! Самое то -сообщение №2! Ух, порву! :):):)
На вкус и цвет...
 
Извините ребята можна еще раз для тех кто на задней парте битых 2-часа не могу подставить код ни по 1-й ни по 2-й схеме.
Не сочтите за грубость файл к примеру прикрепил.
Код
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
    
    'если ячейка не в отслеживаемом диапазоне, то выходим
    If Not Intersect(Target, Range("AA4:AA2000")) Is Nothing Then
      
    'перебираем все ячейки в измененной области
    For Each cell In Intersect(Target, Range("AA4:AA2000"))
        If IsEmpty(cell) Then
        Else
            NewCellValue = cell.Formula     'или ее содержимое
        End If
        On Error Resume Next
          
        With cell
            
        End With
         
        ' ==============================================
        ' дополнительый блок
        ' ==============================================
        Row_ = cell.Row ' запоминаем текущую строку на данной странице. такая же строка будет и на странице истории обслуживания
        Col_ = 32   ' устанавливаем крайний левый столбец.
         
        Do While "" <> Sheets("Лист1").Cells(Row_, Col_).Text ' в цикле считаем заполненные столбцы от крайнего левого столбца. Находим крайний левый пустой столбец на странице истории
                 Col_ = Col_ + 1
        Loop
        ' записываем в пустой столбец на странице истории историю изменения. Тут ее можно компоновать как хочется.
        Sheets("Лист1").Cells(Row_, Col_) = Format(NewCellValue, "DD.MM.YY")
                             
        ' ==============================================
        '  конец дополнительного блока
        ' ==============================================
    Next cell
    ElseIf Intersect(Target, Range("AF3:HF2000")) Is Nothing Then
If Target <> "" Then
If Application.WorksheetFunction.CountIf(Rows(Target.Row), Target.Value) > 1 Then
    Cells(Target.Row, Target.Column) = ""
Else
    Exit Sub
End If
End If
End If
End Sub

Изменено: Ян Копко - 01.12.2020 22:07:14
 
Проверку куда дели?
Код
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.Count > 1 Then Exit Sub

    If Not Intersect(Target, Range("AF3:AS2000, AA2:AA2000")) Is Nothing Then
        If Target.Column = 27 Then
            Call макрос2
        Else
            Call макрос1
        End If
    End If
End Sub

Сначала проверка: если ячейка в одном из указанных диапазонов... Если да, то внутри этого другая проверка: если столбец 27 ("АА"), то выполнить марос2, если же Target в другом диапазоне - выполнить макрос1
 
Цитата
vikttur:Call ìàêðîñ2 … Call ìàêðîñ1
:D
Ян Копко, если в копируемом тексте есть кириллица, то перед копированием убедитесь, что раскладка клавиатуры установлена на кириллицу (русский язык)  ;)
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
... а если не убедились заранее, то исправьте вставленное )
 
За кириллицу благодарю :) буду знать. За косяк извиняюсь
Изменено: Ян Копко - 01.12.2020 21:56:41
 
Цитата
Ян Копко написал:
За косяк извиняюсь
Где косяк? Кто сказал?  :D
По вопросам из тем форума, личку не читаю.
 
[ТС написал в личку]
Цитата
Ян Копко: что такое  If Target.Column = 27
если Target ("целевая" ячейка; в событии изменения листа - это ячейка, которая была изменена) находится в столбце №27 (AA) …
Цитата
Ян Копко: куда мне какой макрос ставить … после Call что я должен вписать
разбираться неинтересно. т.к. тут надо с нуля писать. Советую создать тему ПО ЗАДАЧЕ (типа "VBA. Журнал изменений книги")
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Страницы: 1
Наверх