Страницы: 1
RSS
Запуск макроса при помощи выпадающего списка
 
Доброе время суток
Уважаемые форумчане!

Исходные данные: Есть три простых макроса и  выпадающий список со следующими значениями: (Условие 1, Условие 2, Условие 3)
Задача: Запуск макроса 1 при выборе в выпадающем списке значения "Условие 1" и.т.д.
Теперь вопрос это можно сделать или это утопия. Если можно то как?

P.S. Увидев пример многие скажут, что это можно сделать и формулами. Абсолютно с Вами соглашусь и на данные момент так и делаю, однако данные в таблице являются исходными и затем могут немного меняться в зависимости от результатов конечного продукта. Соответственно приходится удалять формулу для вставки новых данных.
С нетерпением жду вашего мнения по этому вопросу?
Большое спасибо.
 
Щелчок правой кнопкой мыши на ярлыке листа-Исходный текст.
Вставляете этот код:

Код
Private Sub Worksheet_Change(ByVal Target As Range)
 If Not Intersect(Target, Range("B2")) Is Nothing Then
 Application.Run Replace(Target.Value, "Условие ", "Макрос")
 End If
End Sub


P.S. название темы ни о чем. В этот раз именил название сам. В следующий раз просто удалю тему без всяких предупреждений. Изучите уже правила форума - их не так много.
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
Все равно проще формулой. Создайте базу условий которую будете менять при необходимости. А функцией ВПР подтягивайте значения в зависимости от выбора условий. Или вы считаете что макрос править на новые параметры проще?
 
По поводу названия темы. В следующих темах обязательно распишу. Спс
 
Не надо расписывать - здесь не кружок хохломы :-) Надо чтобы название суть вопроса отражало.
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
Всем добрый день! В продолжение темы:
Все понятно если список состоит из одинаковых наименований:
Условие 1
Условие 2
Условие 3

Код при этом:

Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("B2")) Is Nothing Then
Application.Run Replace(Target.Value, "Условие ", "Макрос")
End If
End Sub

а если список состоит из разных наименований, например
A
B
С

Код при этом:

????

Помогите пожалуйста.

Зачем такое попугаистое оформление?
Для оформления кода служит кнопка
<...> [МОДЕРАТОР]
 
Код
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("B2")) Is Nothing Then
    Select Case Target
        Case Is = "A": Call Макрос_A
        Case Is = "B": Call Макрос_B
        Case Is = "C": Call Макрос_C
        Case Else: Call Макрос_Else 'необязательная строка
    End Select
End If
End Sub
Изменено: Sanja - 06.03.2016 12:03:12
Согласие есть продукт при полном непротивлении сторон
 
Код
Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("B2")) Is Nothing Then Exit Sub
        Application.Run "Макрос" & Asc(Target.Value) - 64
End Sub
Изменено: kuklp - 06.03.2016 12:15:02
Я сам - дурнее всякого примера! ...
 
Спасибо огромное всем откликнувшимся!
Уже не первый раз выручаете.
 
Приветствую!
по содержанию данной темы, мне с моим вопросом сюда.
у меня есть форма для запуска проекта, в зависимости от типа проекта (его необходимо выбрать в выпадающем меню, В1), нужно скрывать строки 6-7.
с макросами пока даже не "на вы", поэтому обращаюсь за помощью.
прикладываю свой пример с неудачной попыткой :(  
 
Судя по описанию, Вам нужно В ЛЮБОМ случае (независимо от выбора) скрывать строки 6:7. Уточните задачу.
 
при типе "upgrade" необходимо скрыть строки 6-7, при типах "new". "relocation" отображать данные строки.
 
Замените все, что у Вас в модуле листа, на такой код
Код
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Not Intersect(Target, Range("B1")) Is Nothing Then
    Application.ScreenUpdating = False
    If Target = "upgrade" Then
        Rows("6:7").EntireRow.Hidden = True
    Else
        Rows("6:7").EntireRow.Hidden = False
    End If
End If
Application.ScreenUpdating = True
End Sub
Изменено: Sanja - 18.12.2017 09:55:58
Согласие есть продукт при полном непротивлении сторон
 
If просится под сокращение. :)  
 
:)
Код
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Not Intersect(Target, Range("B1")) Is Nothing Then
    Application.ScreenUpdating = False
    Rows("6:7").EntireRow.Hidden = IIf(Target = "upgrade", True, False)
End If
Application.ScreenUpdating = True
End Sub
Согласие есть продукт при полном непротивлении сторон
 
Код
Rows("6:7").EntireRow.Hidden = (Target = "upgrade")
 
работает! спасибо всем за отзывчивость :)
подскажите еще пож-та, как добавить в код еще один вариант типа проекта, для которого также будут скрываться строки 6-7 (например, с названием "extension") ?
Код
Rows("6:7").EntireRow.Hidden = (Target = "upgrade")
 
Код
Rows("6:7").EntireRow.Hidden = (Target = "upgrade")
Rows("6:7").EntireRow.Hidden = (Target = "extension")
или
Код
Rows("6:7").EntireRow.Hidden = ("*" & Target & "*" Like "upgrade extension")
Изменено: Михаил Лебедев - 18.12.2017 13:08:34
Всё сложное - не нужно. Всё нужное - просто /М. Т. Калашников/
 
Код
Rows("6:7").EntireRow.Hidden = (Target = "upgrade" Xor Target = "extension")
 
ура! все работает, спасибо всем большущее! :)))
 
Добрый день! У меня похожая задача, оптимизировал код - работает, но при удалении данных из ячейки при помощи Del выдает ошибку.
Код должен работать в идеале по следующему алгоритму: При вводе данных при помощи выпадающего списка макрос срабатывал, а при вводе в эту ячейку данных вручную макрос не срабатывает.
Ошибка я так понял происходит в связи с тем что ячейка объединенная, т.к. если ячейка не объединенная этой ошибки нет.
Подскажите как избавиться хотя бы от ошибки Run-time error '13' несовпадение типов.
Изменено: Start - 25.04.2018 16:50:31 (Дополнение)
 
Всем знатокам добрый вечер.
Просьба помочь.
В столбце О выпадающий список со статусом заказа.
В столбцах I, J и N формулы. Необходимо реализовать так, чтобы при выборе статуса "Отгружен", данные по всей строке до статуса преобразовывались в значения.
Чтобы при смене стоимости в марте, не менялась стоимость заказа в феврале (образно)
Благодарю за помощь!
 
Так похоже?
Код
Private Sub Worksheet_Change(ByVal Target As Range)
Dim lR As Long

If Target.Column = 15 Then
If Target.Row > 1 Then
If Target.Value = "Отгружен" Then
   lR = Target.Row
   Range(Cells(lR, 1), Cells(lR, 15)).Value = Range(Cells(lR, 1), Cells(lR, 15)).Value
End If
End If
End If
End Sub
Изменено: Igor67 - 18.12.2019 22:30:47
 
Igor67, Космос. Спасибо огромное!
Скажите, а в чем смысл:If Target.Column = 15 ThenIf Target.Row > 1 Then
lR = Target.Row
  Range(Cells(lR, 1), Cells(lR, 15)).Value = Range(Cells(lR, 1), Cells(lR, 15)).Value?
 
У Вас изменения должны отслеживаться в столбце 15, в строке 1 - заголовок
lR = Target.Row - присваеваем переменной значение равное строке в которой произошло изменение.
а дальше - копируем и втавляем как значения в ячейках контролируемой строки А:О
 
Igor67, Где этому учат и сколько это стоит?
 
Цитата
melnik542 написал:
Где этому учат и сколько это стоит?
Я учусь на форуме и это бесплатно;) Т.е. даром. Необходимо наличие интереса и желания самостоятельно разбираться с задачами.
П.С. На работе прошел курс для ПРОДВИНУТЫХ пользователей за счет работодателя - первый класс средней школы по сравнению с форумом. Единственное систематезировал знания и познакомился с Exc2016, PP, PQ.
 
Igor67,Спасибо)  
Страницы: 1
Наверх