Упрощение макроса вызывающего другой при изменении значния - Мир MS Excel

Регистрация

Напомнить пароль

= Мир MS Excel/Упрощение макроса вызывающего другой при изменении значния - Мир MS Excel

Старая форма входа

Страница 1 из 2 1 2 »
Модератор форума: китин, _Boroda_

Мир MS Excel » Вопросы и решения » Вопросы по VBA » Упрощение макроса вызывающего другой при изменении значния (Формулы)

Упрощение макроса вызывающего другой при изменении значния

Дата: Четверг, 26.09.2013, 09:21 | Сообщение № 1

Группа: Пользователи

Ранг: Новичок

Сообщений: 26

Репутация: 0 ±

Замечаний: 60% ±

Excel 2010

Добрый день,

Есть код написанный кем то. Т.к. я не особо разбираюсь в макросах, то пытался переделать его под свои нужды, но по всей видимости, что то не учел.

[vba]

Код

Sub Worksheet_Change(ByVal Target As Range)
If Target = Range("B8") Or Target = Range("B9") Or Target = Range("B10") Or Target = Range("B11") Or Target = Range("B12") Or Target = Range("B13") Or Target = Range("B14") Or Target = Range("B15") Or Target = Range("B16") Or Target = Range("B17") Then
Call ' [color=green]мой макрос[/color]
End If
End Sub

[/vba]

Вопрос 1: можно ли упростить строку и какой принцип прописание значений в Range("B11")
[vba]

Код

If Target = Range("B8") Or Target = Range("B9") Or Target = Range("B10") Or Target = Range("B11") Or Target = Range("B12") Or Target = Range("B13") Or Target = Range("B14") Or Target = Range("B15") Or Target = Range("B16") Or Target = Range("B17") Then

[/vba]

Вопрос 2: При удалении значений из данных ячеек появляется ошибка
run-time error '13' Type mismatch

Как от нее избавиться?

Сообщение отредактировал Serge_007 - Четверг, 26.09.2013, 10:05

Ответить

Дата: Четверг, 26.09.2013, 09:53 | Сообщение № 2

Группа: Друзья

Ранг: Участник клуба

Сообщений: 4505

Репутация: 1127 ±

Замечаний: 0% ±

Excel 2003

[vba]

Код

If Not Intersect(Range("B8:B17"), Target) Is Nothing Then

[/vba]
Без файла трудно понять ошибку.
Возможно вы удаляете не по одной ячейке.
Тогда сделайте проверку на то сколько ячеек изменилось.
Или нужен цикл, чтобы при удалении обрабатывалась каждая ячейка отдельно.

PS. Прочтите правила форума.

Номер мобильного модема (без голосовой связи)
9269171249 МегаФон, Московский регион.

Ответить

Дата: Четверг, 26.09.2013, 16:20 | Сообщение № 3

Группа: Пользователи

Ранг: Новичок

Сообщений: 26

Репутация: 0 ±

Замечаний: 60% ±

Excel 2010

AlexM, спасибо огромное

Все заработало. И ошибка не выскакивает.
С правилами форума. просто засада. То на одно не обращу внимание, то на другое. Надеюсь скоро все уложится и косячить перестану.
Файл выложить не могу, политика организации не позволяет.
Попробую сделать свой пример, аналогичный проекту, а то впоросов чем дальше, тем больше.

Ответить

Дата: Четверг, 26.09.2013, 16:42 | Сообщение № 4

Группа: Друзья

Ранг: Участник клуба

Сообщений: 3254

Репутация: 707 ±

Замечаний: 0% ±

2019

Оригинальный файл никому и не нужен - нужен файл-пример с аналогичным расположением и форматом данных, минимальный по содержанию.
Т.е. меняете все гранаты на апельсины, удаляете лишние строки, вообще всё не относящееся к делу, лучше переносите лист в новую книгу, её и показываете.
Если есть свой макрос в модуле - добавляете в книгу его (лучше без лишних макросов, не имеющих значения в вопросе).
Тогда и секретность не нарушите, и правила соблюдёте, и помощь быстрее получите, без лишних вопросов.

excel@nxt.ru
webmoney: E265281470651 Z422237915069

Ответить

Дата: Пятница, 27.09.2013, 10:45 | Сообщение № 5

Группа: Пользователи

Ранг: Новичок

Сообщений: 26

Репутация: 0 ±

Замечаний: 60% ±

Excel 2010

AlexM, добрый день

Заработать то, заработало, но не на всем массиве. Исправляюсь и прикладываю файл, анналогичный тому который перестраиваю.
Существует ряд таблиц. Между ними могут быть другие таблицы в которых работа макроса не требуется. Так вот если прописать

[vba]

Код

If Not Intersect(Range("B8:B17"), Target) Is Nothing Then

[/vba]

то вписать больше двух диапазонов не получается. Вписываю третий выдает ошибку.
И еще, так как данных на странице много визуально видно как срабатывает макрос. Он сначала разварачивает строки, потом сварачивает. Не очень красиво. Если это можно как то исправить, было бы отлично

Зарание, спасибо

К сообщению приложен файл: 5872233.xlsm (35.0 Kb)

Ответить

Дата: Пятница, 27.09.2013, 10:56 | Сообщение № 6

Группа: Друзья

Ранг: Участник клуба

Сообщений: 4505

Репутация: 1127 ±

Замечаний: 0% ±

Excel 2003

А если так?
[vba]

Код

If Not Intersect(Range("B4:B23,B28:B47,B52:B71"), Target) Is Nothing Then

[/vba]
Отключите обновление экрана вначале и включите в конце макроса
[vba]

Код

Application.ScreenUpdating = False
...
Application.ScreenUpdating = True

[/vba]

Номер мобильного модема (без голосовой связи)
9269171249 МегаФон, Московский регион.

Сообщение отредактировал AlexM - Пятница, 27.09.2013, 10:58

Ответить

Дата: Пятница, 27.09.2013, 11:19 | Сообщение № 7

Группа: Пользователи

Ранг: Новичок

Сообщений: 26

Репутация: 0 ±

Замечаний: 60% ±

Excel 2010

AlexM, огромное спасибо

Все работает, так как нужно.
У меня к Вам и участникам форума куча вопросов. На выходных попробую собрать их под общей темой.

Еще раз спасибо

Ответить

Дата: Четверг, 03.10.2013, 18:04 | Сообщение № 8

Группа: Пользователи

Ранг: Новичок

Сообщений: 26

Репутация: 0 ±

Замечаний: 60% ±

Excel 2010

В продолжение.

Проект растет обретает свой облик. Столкнулся с тем, что макрос приобретает все большие размеры.
На листах, с которых запускается макрос, прописываю код, любезно исправленный AlexM. Например:

[vba]

Код

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Range("B38:B53, BN2, B1"), Target) Is Nothing Then
Call УдалениеСтрок
End If
End Sub

[/vba]

В модуле прописан код:

[vba]

Код

Sub УдалениеСтрок()
On Error Resume Next

Dim ra As Range, delra As Range, ТекстДляПоиска As String
ТекстДляПоиска = "строку не заполнять"
Application.ScreenUpdating = False
     Sheets("1").Rows.Hidden = False
     Sheets("2").Rows.Hidden = False
     Sheets("3").Rows.Hidden = False
'  и так еще 20 листов, а далее к каждому из них

     Set ra = Nothing
Set delra = Nothing

     For Each ra In Sheets("1").UsedRange.Rows
     If Not ra.Find(ТекстДляПоиска, , xlValues, xlPart) Is Nothing Then
     If delra Is Nothing Then Set delra = ra Else Set delra = Union(delra, ra)
     End If
     Next
     If Not delra Is Nothing Then delra.EntireRow.Hidden = True

     Set ra = Nothing
Set delra = Nothing

     For Each ra In Sheets("2").UsedRange.Rows
     If Not ra.Find(ТекстДляПоиска, , xlValues, xlPart) Is Nothing Then
     If delra Is Nothing Then Set delra = ra Else Set delra = Union(delra, ra)
     End If
     Next
     If Not delra Is Nothing Then delra.EntireRow.Hidden = True

Set ra = Nothing
Set delra = Nothing

    For Each ra In Sheets("3").UsedRange.Rows
     If Not ra.Find(ТекстДляПоиска, , xlValues, xlPart) Is Nothing Then
     If delra Is Nothing Then Set delra = ra Else Set delra = Union(delra, ra)
     End If
     Next
     If Not delra Is Nothing Then delra.EntireRow.Hidden = True

  'и так еще описаны все 20 листов

[/vba]

Вопрос. Можно ли написать код в модуле более универсально? Да еще так, чтобы добавляя новый лист, не нужно было прописывать его в модуле.

В продолжение.

Проект растет обретает свой облик. Столкнулся с тем, что макрос приобретает все большие размеры.
На листах, с которых запускается макрос, прописываю код, любезно исправленный AlexM. Например:

[vba]

Код

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Range("B38:B53, BN2, B1"), Target) Is Nothing Then
Call УдалениеСтрок
End If
End Sub

[/vba]

В модуле прописан код:

[vba]

Код

Sub УдалениеСтрок()
On Error Resume Next

Dim ra As Range, delra As Range, ТекстДляПоиска As String
ТекстДляПоиска = "строку не заполнять"
Application.ScreenUpdating = False
     Sheets("1").Rows.Hidden = False
     Sheets("2").Rows.Hidden = False
     Sheets("3").Rows.Hidden = False
'  и так еще 20 листов, а далее к каждому из них

     Set ra = Nothing
Set delra = Nothing

     For Each ra In Sheets("1").UsedRange.Rows
     If Not ra.Find(ТекстДляПоиска, , xlValues, xlPart) Is Nothing Then
     If delra Is Nothing Then Set delra = ra Else Set delra = Union(delra, ra)
     End If
     Next
     If Not delra Is Nothing Then delra.EntireRow.Hidden = True

     Set ra = Nothing
Set delra = Nothing

     For Each ra In Sheets("2").UsedRange.Rows
     If Not ra.Find(ТекстДляПоиска, , xlValues, xlPart) Is Nothing Then
     If delra Is Nothing Then Set delra = ra Else Set delra = Union(delra, ra)
     End If
     Next
     If Not delra Is Nothing Then delra.EntireRow.Hidden = True

Set ra = Nothing
Set delra = Nothing

    For Each ra In Sheets("3").UsedRange.Rows
     If Not ra.Find(ТекстДляПоиска, , xlValues, xlPart) Is Nothing Then
     If delra Is Nothing Then Set delra = ra Else Set delra = Union(delra, ra)
     End If
     Next
     If Not delra Is Nothing Then delra.EntireRow.Hidden = True

  'и так еще описаны все 20 листов

[/vba]

Вопрос. Можно ли написать код в модуле более универсально? Да еще так, чтобы добавляя новый лист, не нужно было прописывать его в модуле.qshin1980

Ответить

СообщениеВ продолжение.

Проект растет обретает свой облик. Столкнулся с тем, что макрос приобретает все большие размеры.
На листах, с которых запускается макрос, прописываю код, любезно исправленный AlexM. Например:

[vba]

Код

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Range("B38:B53, BN2, B1"), Target) Is Nothing Then
Call УдалениеСтрок
End If
End Sub

[/vba]

В модуле прописан код:

[vba]

Код

Sub УдалениеСтрок()
On Error Resume Next

Dim ra As Range, delra As Range, ТекстДляПоиска As String
ТекстДляПоиска = "строку не заполнять"
Application.ScreenUpdating = False
     Sheets("1").Rows.Hidden = False
     Sheets("2").Rows.Hidden = False
     Sheets("3").Rows.Hidden = False
'  и так еще 20 листов, а далее к каждому из них

     Set ra = Nothing
Set delra = Nothing

     For Each ra In Sheets("1").UsedRange.Rows
     If Not ra.Find(ТекстДляПоиска, , xlValues, xlPart) Is Nothing Then
     If delra Is Nothing Then Set delra = ra Else Set delra = Union(delra, ra)
     End If
     Next
     If Not delra Is Nothing Then delra.EntireRow.Hidden = True

     Set ra = Nothing
Set delra = Nothing

     For Each ra In Sheets("2").UsedRange.Rows
     If Not ra.Find(ТекстДляПоиска, , xlValues, xlPart) Is Nothing Then
     If delra Is Nothing Then Set delra = ra Else Set delra = Union(delra, ra)
     End If
     Next
     If Not delra Is Nothing Then delra.EntireRow.Hidden = True

Set ra = Nothing
Set delra = Nothing

    For Each ra In Sheets("3").UsedRange.Rows
     If Not ra.Find(ТекстДляПоиска, , xlValues, xlPart) Is Nothing Then
     If delra Is Nothing Then Set delra = ra Else Set delra = Union(delra, ra)
     End If
     Next
     If Not delra Is Nothing Then delra.EntireRow.Hidden = True

  'и так еще описаны все 20 листов

[/vba]

Вопрос. Можно ли написать код в модуле более универсально? Да еще так, чтобы добавляя новый лист, не нужно было прописывать его в модуле.

Автор - qshin1980
Дата добавления - 03.10.2013 в 18:04

Дата: Четверг, 03.10.2013, 18:11 | Сообщение № 9

Группа: Друзья

Ранг: Старожил

Сообщений: 1206

Репутация: 255 ±

Замечаний: 0% ±

2010

Используйте цикл:
[vba]

Код

Dim sh as worksheet
For each sh in thisworkbook.worksheets
' Ваши процедуры. В данном случае sh.name = sheets(от 1 до последнего листа).name
next

[/vba]
Или
[vba]

Код

Dim sh&
For sh = 1 to sheets.count
' Ваши процедуры. А тут нужно прописывать sheets(sh).name (name добавлено для наглядности)
next

[/vba]

skypro1111@gmail.com

Сообщение отредактировал SkyPro - Четверг, 03.10.2013, 18:16

Ответить

Дата: Четверг, 03.10.2013, 22:07 | Сообщение № 10

Группа: Друзья

Ранг: Форумчанин

Сообщений: 232

Репутация: 50 ±

Замечаний: 0% ±

SkyPro, Я бы поступил иначе! Во первых в вашем способ не учтено что листы могут добавляться и в каждом добавляемом нужно прописывать Worksheet_Change,
Во вторых я предполагаю что процедура должна выполняться не одновременно для всех листов а только для активного. Если я прав то я бы поступил иначе.
1) Прописываем модуль класов в котором будем отлавливать событие Worksheet_Change для ВСЕХ листов книги что избавляет нас от необходимости на КАЖДОМ листе прописывать ОДИНАКОВЫЕ Worksheet_Change
2) если я прав и макрос должен работать только для активного листа то заменяю в модуле все ссылки на конкретный лист ссылками на ActiveSheet что избавит от необходимости дописывать одинаковый обработчик для всех листов.
Но пока это мои догадки и ТС их не подтвердит конкретного макроса писать нехочу

Сообщение отредактировал Poltava - Четверг, 03.10.2013, 22:08

Ответить

Дата: Четверг, 03.10.2013, 23:25 | Сообщение № 11

Группа: Модераторы

Ранг: Местный житель

Сообщений: 16675

Репутация: 6481 ±

Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS

А не проще будет положить все это в модуль книги, а не в модуль листа?
[vba]

Код

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
'тут код макроса, в котором:
'''Sh - лист, где происходят изменения
'''Target - диапазон на этом листе
End Sub

[/vba]

Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995

Ответить

Дата: Четверг, 03.10.2013, 23:45 | Сообщение № 12

Группа: Друзья

Ранг: Форумчанин

Сообщений: 232

Репутация: 50 ±

Замечаний: 0% ±

_Boroda_, В модуль книги еще проще ненужно с класами заморачиваться! А то я как то забыл о том что есть Workbook_SheetChange. просто писал только что код чтобы в нескольких книгах события отлавливать вот меня на модуль класов и перемкнуло! иконечно же через Workbook_SheetChange будет проще.

Ответить

Дата: Пятница, 04.10.2013, 08:17 | Сообщение № 13

Группа: Пользователи

Ранг: Новичок

Сообщений: 26

Репутация: 0 ±

Замечаний: 60% ±

Excel 2010

Добрый день,

Poltava, запись worksheet _change, на листах, особо не напрягает. Тем более, что на разных листах, ячейки запускающие процедуру УдалениеСтрок разные. Главная задача упростить саму процедуру удаления строк и по возможности сделать так, чтобы не нужно было дописывать наименование листов на которых нужно ее запустить. По умолчанию при любом изменении назначенных ячеек все листы имеющие статус visible = true прочесывались на эту процедуру.

Ответить

Дата: Пятница, 04.10.2013, 08:20 | Сообщение № 14

Группа: Пользователи

Ранг: Новичок

Сообщений: 26

Репутация: 0 ±

Замечаний: 60% ±

Excel 2010

Забыл уточнить, работать она должна не только на активном листе

Ответить

Дата: Пятница, 04.10.2013, 10:01 | Сообщение № 15

Группа: Друзья

Ранг: Участник клуба

Сообщений: 4505

Репутация: 1127 ±

Замечаний: 0% ±

Excel 2003

В ваших сообщениях не хватает самого главного - файла-примера (несколько листов с непустыми таблицами) под вновь появившиеся идеи.
Еще было бы неплохо на словах пояснить что должен делать макрос "УдалениеСтрок" так как показанный код ничего не удаляет.

Номер мобильного модема (без голосовой связи)
9269171249 МегаФон, Московский регион.

Ответить

Дата: Пятница, 04.10.2013, 10:11 | Сообщение № 16

Группа: Пользователи

Ранг: Новичок

Сообщений: 26

Репутация: 0 ±

Замечаний: 60% ±

Excel 2010

Как раз сижу делаю его. Сделать пример оказалось сложнее, чем основной проект. Пытаюсь провести параллели между основными задачами и новыми яблоками и грушами)))

Ответить

Дата: Пятница, 04.10.2013, 11:04 | Сообщение № 17

Группа: Пользователи

Ранг: Новичок

Сообщений: 26

Репутация: 0 ±

Замечаний: 60% ±

Excel 2010

Вот что получилось

На листе "Assorti", есть кнопка "Изменить ассортимент". Нажимаем, получается новый лист (код наверно жутко примитивный но работает. В идеале название листа должно быть "Изменения_Клиент1", но как это сделать я не знаю). Так вот, при появлении нового листа "Изменения", т.к. он не прописан в процедуру "УдалениеСтрокПоУсловию" код на этом листе не работает. Если название листа прописывать изначально в код процедуры "УдалениеСтрокПоУсловию", то выдает ошибку при работе с остальными листами, до того как появится лист "Изменения". Я прописал в процедуру

[vba]

Код

On Error Resume Next

[/vba]

ошибку не выдает, но это не панацея.

Из этого и вопрос: как прописать процедуру "УдалениеСтрокПоУсловию", чтобы она работала на всех листах книги и независила от названия листа.

К сообщению приложен файл: 7569546.xlsm (67.2 Kb)

Сообщение отредактировал qshin1980 - Пятница, 04.10.2013, 11:06

Ответить

Дата: Пятница, 04.10.2013, 11:30 | Сообщение № 18

Группа: Друзья

Ранг: Экселист

Сообщений: 5660

Репутация: 1163 ±

Замечаний: 0% ±

2010

самый простой вариант
Замените это
[vba]

Код

Sheets("Итог").Rows.Hidden = False
      Sheets("Итог (2)").Rows.Hidden = False
      Sheets("Итог (3)").Rows.Hidden = False
      Sheets("Итог (4)").Rows.Hidden = False
      Sheets("Assorti").Rows.Hidden = False

[/vba]
на это
[vba]

Код

For i = 3 To Sheets.Count
Sheets(i).Rows.Hidden = False
Next

[/vba]

А вообще
[vba]

Код

Sub Мяу()
     Dim ra As Range, delra As Range, ТекстДляПоиска As String
     ТекстДляПоиска = "строку не заполнять"
     Application.ScreenUpdating = False
     For i = 3 To Sheets.Count
         With Sheets(i)
             .Rows.Hidden = False
             For Each ra In .UsedRange.Rows
                 If Not ra.Find(ТекстДляПоиска, , xlValues, xlPart) Is Nothing Then
                     If delra Is Nothing Then Set delra = ra Else Set delra = Union(delra, ra)
                 End If
                 If Not delra Is Nothing Then delra.EntireRow.Hidden = True
             Next
         End With
     Next
     Application.ScreenUpdating = True
End Sub

[/vba]

Быть или не быть, вот в чем загвоздка!

Сообщение отредактировал RAN - Пятница, 04.10.2013, 11:38

Ответить

Дата: Пятница, 04.10.2013, 14:30 | Сообщение № 19

Группа: Пользователи

Ранг: Новичок

Сообщений: 26

Репутация: 0 ±

Замечаний: 60% ±

Excel 2010

RAN,

Заменил на "а вообще", в примере работает, а в пректе выдает ошибку в строке

[vba]

Код

If delra Is Nothing Then Set delra = ra Else Set delra = Union(delra, ra)

[/vba]

Выделяя код

[vba]

Код

Set delra = Union(delra, ra)

[/vba]

Я стаким кодом не справлюсь, выручайте

Сообщение отредактировал qshin1980 - Пятница, 04.10.2013, 14:31

Ответить

Дата: Пятница, 04.10.2013, 15:13 | Сообщение № 20

Группа: Друзья

Ранг: Форумчанин

Сообщений: 232

Репутация: 50 ±

Замечаний: 0% ±

скорее всего Ваш пример слабо соответствует действительности.
1)Не понятно когда должно срабатывать Worksheet_Change то есть при каких условиях
2)Непонятно почему нужно перебирать ВСЕ листы???

Ответить

Мир MS Excel » Вопросы и решения » Вопросы по VBA » Упрощение макроса вызывающего другой при изменении значния (Формулы)

Страница 1 из 2
1
2
»

© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!