Автоматический запуск макроса при изменении значений в ячейке

Весь MS Office, программирование на Visual Basic for Applications и MS VB

Модератор: Naeel Maqsudov

Ответить
ipcp
Сообщения: 5
Зарегистрирован: 14 ноя 2009, 12:20

Здравствуйте.
Помогите с проблемой, плиз.
Есть макрос который сравнивает и форматирует ячейки таблицы.
Необходимо автоматический запуск данного макроса при изменении любой ячейки в таблице.
SAS888
Сообщения: 156
Зарегистрирован: 16 янв 2008, 08:28

В модуль требуемого листа поместите код:

Код: Выделить всё

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rng As Range: Set rng = [A1:F10] 'диапазон Вашей таблицы
    If Not Intersect(rng, Target) Is Nothing Then MyMacro
End Sub
Теперь, при изменении значения любой из ячеек диапазона "A1:F10" будет запущен макрос "MyMacro".
Будьте внимательны! Если Ваш макрос будет работать с ячейками таблицы, то в начале процедуры необходимо отключить обработчик событий командой Application.EnableEvents = False. По окончании процедуры, естественно, включить его Application.EnableEvents = True.
svat
Сообщения: 3
Зарегистрирован: 13 фев 2010, 10:59

SAS888 писал(а):В модуль требуемого листа поместите код:

Код: Выделить всё

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rng As Range: Set rng = [A1:F10] 'диапазон Вашей таблицы
    If Not Intersect(rng, Target) Is Nothing Then MyMacro
End Sub
Теперь, при изменении значения любой из ячеек диапазона "A1:F10" будет запущен макрос "MyMacro".
Будьте внимательны! Если Ваш макрос будет работать с ячейками таблицы, то в начале процедуры необходимо отключить обработчик событий командой Application.EnableEvents = False. По окончании процедуры, естественно, включить его Application.EnableEvents = True.

я что-то так и не понял как делать, я уж и так и эдак вставлял не получается. Может кто-нибудь сможет видоизменить мой макрос, чтобы он запускался при внесении числа в ячейку, то есть если в одном листе excel-евского файла в какой-то ячейке ввести число например 543 то макрос переходит не визуально, а в памяти, на другой лист файла, а там таблица из нескольких столбцов с числами, так вот макрос находит в определенном солбце это (543) число, далее сравнивает рядом с ним стоящее в одной строке число с нулем, если оно меньше нуля то макрос возвращает в ту ячейку куда вводили число 543 значение того отрицательного числа которое стоит рядом в одной строке с числом 543. Ну а если число которое стоит в таблице рядом с 543 больше нуля то макрос ни чего не делает, а оператор вводит данные в другую ячейку. Ну в общем-то как сравнивать числа и выводить число в какую-то ячейку с этим я сам справлюсь, а вот как написать чтобы макрос начинал работу после введения данных в ячейку - вот это я не знаю. Кто знает подскажите пожалуйста?


Sub сравнение()
'
' сравнение Макрос
' Макрос записан 13.02.2010 (ккк)
'
' Сочетание клавиш: Ctrl+s
'
Dim a As Integer ' - это номер строки в таблице где происходит сравнение
Dim n As Integer ' - это переменная которой присваивается значение числа после того как его ввели
Dim x As Integer ' - это номер строки на которой находиться ячейка в которую вводиться число
Dim y As Integer ' - это номер столбца в котором находиться ячейка в которую вводиться число

a = 1 'задается номер строки с которой начинаем

' ВОТ ТУТ КАК РАЗ В МЕСТО ЭТИХ ТРЕХ СТРОЧЕК И ДОЛЖНА ПО ИДЕЕ БЫТЬ КОМАНДА
' КОТОРАЯ ЗАПУСКАЕТ МАКРОС ПОСЛЕ ВВОДА ЧИСЛА В ЯЧЕЙКУ

' Range("B2").Select
' ActiveCell.FormulaR1C1 = "543"
' n = введенному в ячейку числу


x = 2 ' для того чтобы макрос хоть как то работал задаем умышленно фиксированное значение
y = 2 ' для того чтобы макрос хоть как то работал задаем умышленно фиксированное значение
n = Sheets("лист-данные").Cells(x, y) 'присваиваем переменной n значение введенного в ячейку числа
2 If n = Sheets("лист-таблица").Cells(a, 1) Then GoTo 1 ' находим такое же число как оператор вводил но уже в эталонной таблице
a = a + 1
If a <= 50 Then GoTo 2
1 If Sheets("лист-таблица").Cells(a, 2) > 0 Then GoTo 3 ' Число найдено, а сдесь выясняем отрицательное ли число которое стоит рядом в эталонной таблице

Sheets("лист-данные").Cells(x, y) = Sheets("лист-таблица").Cells(a, 2) 'присваивается здачение отрицательного числа ячейке в которую изначально был ввод
Sheets("лист-данные").Select 'ну тут ниже меняетс цвет шриф для яркости
Cells(x, y).Select
Selection.Font.ColorIndex = 3
Selection.Font.Bold = True
With Selection.Font
.Name = "Arial Cyr"
.Size = 12
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 3
End With
pause (20 = cek) ' то же не знаю как писать паузу в работе, а она нужна чтобы оператор увидел результат
4 r = r + 1
If r < 50000000 Then GoTo 4 ' пришлось вместо паузы вот такой ерундой заниматься
Selection.ClearContents 'очистка ячейки куда был ввод
Selection.Font.ColorIndex = 1

3 End Sub

Естественно макрос до коца не проработан, да это не главное сейча для меня, проработаю, мне важно начало его написать.
SAS888
Сообщения: 156
Зарегистрирован: 16 янв 2008, 08:28

Ну, во-первых, нужно определиться с диапазоном ячеек таблицы, при изменении которых должен запускаться макрос. Из Вашего примера это не ясно. Во-вторых, чтобы макрос запускался автоматически по событию изменения значения в ячейке (диапазоне ячеек), он должен находиться в модуле соответствующего листа и иметь имя Worksheet_Change(ByVal Target As Range)
Посмотрите пример во вложении. В коде подробные комментарии. Что не так? Что не понятно?
Dimitri4
Сообщения: 1
Зарегистрирован: 01 окт 2013, 21:02

Это все для одного диапазона, а как задать сразу несколько диапазонов с ячейками, которые подвергаются изменению, и для каждого диапазона отдельно свой макрос с результатом изменений ?*
я пробовал, но возникает ошибка ?
Кто знает подскажите плиз что делать !
Аватара пользователя
Naeel Maqsudov
Сообщения: 2570
Зарегистрирован: 20 фев 2004, 19:17
Откуда: Moscow, Russia
Контактная информация:

Процедура Worksheet_Change должна быть одна, как предлагал SAS888 ранее, но вы там напишите больше условий:

Код: Выделить всё

If Not Intersect(rng1, Target) Is Nothing Then 
   MyMacro1
elseif Not Intersect(rng2, Target) Is Nothing Then 
   MyMacro2
elseif Not Intersect(rng3, Target) Is Nothing Then 
   MyMacro3
end if
Ответить