Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Пользователи » Flaber2004
Выбрать дату в календаре…Выбрать дату в календаре

Страницы: 1
Нужно, чтобы макрос сработал при условии значения рядом в ячейке
 
#
15.10.2020 17:55:55
Подскажите, а можно в мой код добавить условие что бы ВПР срабатывал от значения в ячейки. т.е если Е10 изменил и в ячейке А10 написано "привез" будет 1, а если отвез то ВПР сработал. Заранее спасибо

Код
Private Sub Worksheet_Change(ByVal Target As Range)
   If Target.Cells.Count > 1 Then Exit Sub
    Application.EnableEvents = 0
    'телефон
    
    If Not Intersect(Target, Me.Range("E6:E300"), Me.UsedRange) Is Nothing Then
          Target.Offset(, 1) = Application.VLookup(Target, [справочник], 12, 0)
    'объем
    If Not Intersect(Target, Me.Range("E6:E300"), Me.UsedRange) Is Nothing Then
        Target.Offset(, 2) = Application.VLookup(Target, [справочник], 15, 0)
    'Зп водителя
    If Not Intersect(Target, Me.Range("E6:E300"), Me.UsedRange) Is Nothing Then
        Target.Offset(, 7) = Application.VLookup(Target, [справочник], 16, 0)
    'Юр лицо
    If Not Intersect(Target, Me.Range("E6:E300"), Me.UsedRange) Is Nothing Then
        Target.Offset(, 11) = Application.VLookup(Target, [справочник], 6, 0)
    'Адрес
    If Not Intersect(Target, Me.Range("E6:E300"), Me.UsedRange) Is Nothing Then
        Target.Offset(, 12) = Application.VLookup(Target, [справочник], 17, 0)
    'Район
    If Not Intersect(Target, Me.Range("E6:E300"), Me.UsedRange) Is Nothing Then
        Target.Offset(, 13) = Application.VLookup(Target, [справочник], 9, 0)
    'Мин
    If Not Intersect(Target, Me.Range("E6:E300"), Me.UsedRange) Is Nothing Then
        Target.Offset(, 14) = Application.VLookup(Target, [справочник], 14, 0)
    'БП/БПП
    If Not Intersect(Target, Me.Range("E6:E300"), Me.UsedRange) Is Nothing Then
        Target.Offset(, 8) = Application.VLookup(Target, [справочник], 3, 0)
    'Менеджер
    If Not Intersect(Target, Me.Range("E6:E300"), Me.UsedRange) Is Nothing Then
        Target.Offset(, 9) = Application.VLookup(Target, [справочник], 7, 0)
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    
    Application.EnableEvents = 1
End Sub
 
Перейти    
Остановка кода при удалении строки, Остановить макрос если не найдено значение
 
#
15.10.2020 17:13:57
Здравствуйте Всем, есть такой код, при удалении строки на листе где этот код расположен, он ругается. Как это исправить помогите пожалуйста
Код
Private Sub Worksheet_Change(ByVal Target As Range)
   
    Application.EnableEvents = 0
    'телефон
    
    If Not Intersect(Target, Me.Range("E6:E300"), Me.UsedRange) Is Nothing Then
          Target.Offset(, 1) = Application.IFERRORVLookup(Target, [справочник], 12, 0)
    'объем
    If Not Intersect(Target, Me.Range("E6:E300"), Me.UsedRange) Is Nothing Then
        Target.Offset(, 2) = Application.VLookup(Target, [справочник], 15, 0)
    'Зп водителя
    If Not Intersect(Target, Me.Range("E6:E300"), Me.UsedRange) Is Nothing Then
        Target.Offset(, 7) = Application.VLookup(Target, [справочник], 16, 0)
    'Юр лицо
    If Not Intersect(Target, Me.Range("E6:E300"), Me.UsedRange) Is Nothing Then
        Target.Offset(, 11) = Application.VLookup(Target, [справочник], 6, 0)
    'Адрес
    If Not Intersect(Target, Me.Range("E6:E300"), Me.UsedRange) Is Nothing Then
        Target.Offset(, 12) = Application.VLookup(Target, [справочник], 17, 0)
    'Район
    If Not Intersect(Target, Me.Range("E6:E300"), Me.UsedRange) Is Nothing Then
        Target.Offset(, 13) = Application.VLookup(Target, [справочник], 9, 0)
    'Мин
    If Not Intersect(Target, Me.Range("E6:E300"), Me.UsedRange) Is Nothing Then
        Target.Offset(, 14) = Application.VLookup(Target, [справочник], 14, 0)
        
    End If
     End If
    End If
    End If
    End If
    End If
    End If
    End If
    Application.EnableEvents = 1
End Sub
 
Перейти    
Страницы: 1
Наверх