Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

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

 

= Мир MS Excel/Ускорить работу макроса нахождения кол-ва по трем условиям - Страница 2 - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
Страница 2 из 2«12
Модератор форума: _Boroda_, Pelena, Manyasha, SLAVICK 
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Ускорить работу макроса нахождения кол-ва по трем условиям (Макросы/Sub)
Ускорить работу макроса нахождения кол-ва по трем условиям
_Boroda_ Дата: Среда, 03.08.2016, 13:29 | Сообщение № 21
Группа: Модераторы
Ранг: Экселист
Сообщений: 9786
Репутация: 4135 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
Тадатак
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("A2:B4")) Is Nothing Then'"A2:B4" - твой диапазон
        Sheets("состав").СУММПР_3
    End If
End Sub
[/vba]


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
СообщениеТадатак
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("A2:B4")) Is Nothing Then'"A2:B4" - твой диапазон
        Sheets("состав").СУММПР_3
    End If
End Sub
[/vba]

Автор - _Boroda_
Дата добавления - 03.08.2016 в 13:29
китин Дата: Среда, 03.08.2016, 13:55 | Сообщение № 22
Группа: Друзья
Ранг: Участник клуба
Сообщений: 3673
Репутация: 573 ±
Замечаний: 0% ±

Excel 2007;Excel 2010
ага, понял. а при сохранении книги что бы он срабатывал?


Не судите строго:я пытаюсь научиться
ЯД 41001877306852/WM R249698041931; Z239672726538
 
Ответить
Сообщениеага, понял. а при сохранении книги что бы он срабатывал?

Автор - китин
Дата добавления - 03.08.2016 в 13:55
китин Дата: Среда, 03.08.2016, 14:14 | Сообщение № 23
Группа: Друзья
Ранг: Участник клуба
Сообщений: 3673
Репутация: 573 ±
Замечаний: 0% ±

Excel 2007;Excel 2010
а вот теперь ничего не понимаю: малость переделанный код из 1 поста
[vba]
Код
Sub СУММПР_4()
  Application.ScreenUpdating = False
     Dim lLastRow As Long
     Dim lLastCol As Long
    
        lLastRow = Cells(Rows.Count, 3).End(xlUp).Row
    
Sheets("Расход").Range("I3").FormulaLocal = "=ЕСЛИ(ЕНД(ИНДЕКС(Приход!$I$3:$I$15000;ПОИСКПОЗ(Расход!$C3;Приход!$C$3:$C$15000;0)));0;ИНДЕКС(Приход!$I$3:$I$15000;ПОИСКПОЗ(Расход!$C3;Приход!$C$3:$C$15000;0)))" 'вставляем формулу в 1 строку
    Range("I3").Select
     Application.CutCopyMode = False
      Selection.AutoFill Destination:=Range(Cells(3, 9), Cells(lLastRow, 9)), Type:=xlFillDefault 'копируем на весь диапазон
    Range(Cells(3, 9), Cells(lLastRow, 9)).Select
      Selection.Copy ' копируем
         Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
         :=False, Transpose:=False 'вставляем значения
     
     Dim sh As Worksheet, r As Range
If ActiveWindow.SelectedSheets.Count > 1 Then 'Проверяем сколько листов выделено
    For Each sh In ActiveWindow.SelectedSheets 'Для всех выделенных листов
        Set r = sh.UsedRange 'определение рабочего диапазона листа
        r.Replace 0, "", xlWhole 'замена нулевых ячеек на пусто
    Next

    Else
    'Если да
        For Each sh In ActiveWorkbook.Sheets 'Для всех листов в книге
            Set r = sh.UsedRange 'определение рабочего диапазона листа
            r.Replace 0, "", xlWhole 'замена нулевых ячеек на пусто
        Next
    End If

End Sub
[/vba]
при проверке при помощи клавиши F8 срабатывает на ура. Нажимаю Alt F8 выбираю СУММПР_4() нажимаю выполнить-вышибает весь Excel напрочь с закрытием всех открытых файлов. непонятненько %)



Не судите строго:я пытаюсь научиться
ЯД 41001877306852/WM R249698041931; Z239672726538
 
Ответить
Сообщениеа вот теперь ничего не понимаю: малость переделанный код из 1 поста
[vba]
Код
Sub СУММПР_4()
  Application.ScreenUpdating = False
     Dim lLastRow As Long
     Dim lLastCol As Long
    
        lLastRow = Cells(Rows.Count, 3).End(xlUp).Row
    
Sheets("Расход").Range("I3").FormulaLocal = "=ЕСЛИ(ЕНД(ИНДЕКС(Приход!$I$3:$I$15000;ПОИСКПОЗ(Расход!$C3;Приход!$C$3:$C$15000;0)));0;ИНДЕКС(Приход!$I$3:$I$15000;ПОИСКПОЗ(Расход!$C3;Приход!$C$3:$C$15000;0)))" 'вставляем формулу в 1 строку
    Range("I3").Select
     Application.CutCopyMode = False
      Selection.AutoFill Destination:=Range(Cells(3, 9), Cells(lLastRow, 9)), Type:=xlFillDefault 'копируем на весь диапазон
    Range(Cells(3, 9), Cells(lLastRow, 9)).Select
      Selection.Copy ' копируем
         Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
         :=False, Transpose:=False 'вставляем значения
     
     Dim sh As Worksheet, r As Range
If ActiveWindow.SelectedSheets.Count > 1 Then 'Проверяем сколько листов выделено
    For Each sh In ActiveWindow.SelectedSheets 'Для всех выделенных листов
        Set r = sh.UsedRange 'определение рабочего диапазона листа
        r.Replace 0, "", xlWhole 'замена нулевых ячеек на пусто
    Next

    Else
    'Если да
        For Each sh In ActiveWorkbook.Sheets 'Для всех листов в книге
            Set r = sh.UsedRange 'определение рабочего диапазона листа
            r.Replace 0, "", xlWhole 'замена нулевых ячеек на пусто
        Next
    End If

End Sub
[/vba]
при проверке при помощи клавиши F8 срабатывает на ура. Нажимаю Alt F8 выбираю СУММПР_4() нажимаю выполнить-вышибает весь Excel напрочь с закрытием всех открытых файлов. непонятненько %)


Автор - китин
Дата добавления - 03.08.2016 в 14:14
Manyasha Дата: Среда, 03.08.2016, 18:07 | Сообщение № 24
Группа: Модераторы
Ранг: Старожил
Сообщений: 1721
Репутация: 722 ±
Замечаний: 0% ±

Excel 2007, 2010
Игорь, в файле из 1-го поста нет листов Приход, Расход.
Если переделать все через массивы со словарями (аналогично СУММПР_3), будет быстрее.

Без переделки на словари можно попробовать следующее:
формулу в макросе заменить на
Код
ЕСЛИОШИБКА(ИНДЕКС(Приход!$I$3:$I$15000;ПОИСКПОЗ(Расход!$C3;Приход!$C$3:$C$15000;0));0)

в начало макроса добавить:
[vba]
Код
With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
    .EnableEvents = False
End With
[/vba]
в конец макроса:
[vba]
Код
With Application
    .Calculation = xlCalculationAutomatic
    .ScreenUpdating = True
    .EnableEvents = True
End With
[/vba]
15000 в формуле - это с большим запасом? Можно найти последнюю строчку на листе Приход и подставить ее номер вместо 15000

что бы он срабатывал при любом изменении на листе " План"?
а какие камни могут быть?

такие, что
мои объемы просчитал за 1,5 минуты
и так при любом изменении))
Может лучше при активации листа План?


marinamorozova_box@mail.ru
ЯД: 410013299366744 WM: R193491431804
 
Ответить
СообщениеИгорь, в файле из 1-го поста нет листов Приход, Расход.
Если переделать все через массивы со словарями (аналогично СУММПР_3), будет быстрее.

Без переделки на словари можно попробовать следующее:
формулу в макросе заменить на
Код
ЕСЛИОШИБКА(ИНДЕКС(Приход!$I$3:$I$15000;ПОИСКПОЗ(Расход!$C3;Приход!$C$3:$C$15000;0));0)

в начало макроса добавить:
[vba]
Код
With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
    .EnableEvents = False
End With
[/vba]
в конец макроса:
[vba]
Код
With Application
    .Calculation = xlCalculationAutomatic
    .ScreenUpdating = True
    .EnableEvents = True
End With
[/vba]
15000 в формуле - это с большим запасом? Можно найти последнюю строчку на листе Приход и подставить ее номер вместо 15000

что бы он срабатывал при любом изменении на листе " План"?
а какие камни могут быть?

такие, что
мои объемы просчитал за 1,5 минуты
и так при любом изменении))
Может лучше при активации листа План?

Автор - Manyasha
Дата добавления - 03.08.2016 в 18:07
китин Дата: Четверг, 04.08.2016, 07:24 | Сообщение № 25
Группа: Друзья
Ранг: Участник клуба
Сообщений: 3673
Репутация: 573 ±
Замечаний: 0% ±

Excel 2007;Excel 2010
Спасибо Марина.
15000 в формуле - это с большим запасом?

нет. запас примерно 500-700 строк
в файле из 1-го поста нет листов Приход, Расход.

ну дык и пишу
малость переделанный код из 1 поста
:D
. И это столь принципиально? вместо ЕСЛИ(ЕНД ставить ЕСЛИОШИБКА ? Я специально писал формулу под 2003 офис.( на работе еще не всем 2007 поставили, не говоря уж про более высокие)


Не судите строго:я пытаюсь научиться
ЯД 41001877306852/WM R249698041931; Z239672726538
 
Ответить
СообщениеСпасибо Марина.
15000 в формуле - это с большим запасом?

нет. запас примерно 500-700 строк
в файле из 1-го поста нет листов Приход, Расход.

ну дык и пишу
малость переделанный код из 1 поста
:D
. И это столь принципиально? вместо ЕСЛИ(ЕНД ставить ЕСЛИОШИБКА ? Я специально писал формулу под 2003 офис.( на работе еще не всем 2007 поставили, не говоря уж про более высокие)

Автор - китин
Дата добавления - 04.08.2016 в 07:24
Manyasha Дата: Четверг, 04.08.2016, 11:04 | Сообщение № 26
Группа: Модераторы
Ранг: Старожил
Сообщений: 1721
Репутация: 722 ±
Замечаний: 0% ±

Excel 2007, 2010
Я конечно не проверяла, но по логике в формуле с ЕСЛИ(ЕНД считается сначала связка Индекс+Поископоз и, если ошибка, эта же связка считается второй раз.
А если оставить просто Индекс+Поискпоз, а Н/Д-ки удалять так?
[vba]
Код
    Range(Cells(3, 9), Cells(lLastRow, 9)).Select
    Selection.SpecialCells(xlCellTypeFormulas, 16).ClearContents 'эту строчку добавить
    Selection.Copy ' копируем
[/vba]


marinamorozova_box@mail.ru
ЯД: 410013299366744 WM: R193491431804
 
Ответить
СообщениеЯ конечно не проверяла, но по логике в формуле с ЕСЛИ(ЕНД считается сначала связка Индекс+Поископоз и, если ошибка, эта же связка считается второй раз.
А если оставить просто Индекс+Поискпоз, а Н/Д-ки удалять так?
[vba]
Код
    Range(Cells(3, 9), Cells(lLastRow, 9)).Select
    Selection.SpecialCells(xlCellTypeFormulas, 16).ClearContents 'эту строчку добавить
    Selection.Copy ' копируем
[/vba]

Автор - Manyasha
Дата добавления - 04.08.2016 в 11:04
китин Дата: Понедельник, 31.10.2016, 08:23 | Сообщение № 27
Группа: Друзья
Ранг: Участник клуба
Сообщений: 3673
Репутация: 573 ±
Замечаний: 0% ±

Excel 2007;Excel 2010
Доброго всем времечка!!!! Подниму свою тему. Все работает прекрасно, внедрено и размножено. Возник один вопросик. а что добавить в код, что бы при добавлении данных в лист план в листе Состав считалось только это добавление? а все ранее посчитанные данные оставались неизменными? То есть добавляем цифирку в лист план , к примеру на 20е число. нажимаем кнопку. и к имеющимся уже данным в диапазоне C1:AG30 листа Состав добавляется только расчет вновь добавленной цифры на листе План.
К сообщению приложен файл: 3547094.xlsm(70Kb)


Не судите строго:я пытаюсь научиться
ЯД 41001877306852/WM R249698041931; Z239672726538
 
Ответить
СообщениеДоброго всем времечка!!!! Подниму свою тему. Все работает прекрасно, внедрено и размножено. Возник один вопросик. а что добавить в код, что бы при добавлении данных в лист план в листе Состав считалось только это добавление? а все ранее посчитанные данные оставались неизменными? То есть добавляем цифирку в лист план , к примеру на 20е число. нажимаем кнопку. и к имеющимся уже данным в диапазоне C1:AG30 листа Состав добавляется только расчет вновь добавленной цифры на листе План.

Автор - китин
Дата добавления - 31.10.2016 в 08:23
Pelena Дата: Понедельник, 31.10.2016, 08:32 | Сообщение № 28
Группа: Модераторы
Ранг: Экселист
Сообщений: 10385
Репутация: 2353 ±
Замечаний: 0% ±

Excel 2010 & Mac Excel 2011
Игорь, новый вопрос - новая тема. Забыл?


"Черт возьми, Холмс! Но как??!!"
ЯД 41001765434816
 
Ответить
СообщениеИгорь, новый вопрос - новая тема. Забыл?

Автор - Pelena
Дата добавления - 31.10.2016 в 08:32
китин Дата: Понедельник, 31.10.2016, 08:45 | Сообщение № 29
Группа: Друзья
Ранг: Участник клуба
Сообщений: 3673
Репутация: 573 ±
Замечаний: 0% ±

Excel 2007;Excel 2010
Забыл?
не проснулся :D каюсь, исправляюсь
:p ray:
[p.s.]Лена тогда м.б. закрыть тему?


Не судите строго:я пытаюсь научиться
ЯД 41001877306852/WM R249698041931; Z239672726538


Сообщение отредактировал китин - Понедельник, 31.10.2016, 08:49
 
Ответить
Сообщение
Забыл?
не проснулся :D каюсь, исправляюсь
:p ray:
[p.s.]Лена тогда м.б. закрыть тему?

Автор - китин
Дата добавления - 31.10.2016 в 08:45
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Ускорить работу макроса нахождения кол-ва по трем условиям (Макросы/Sub)
Страница 2 из 2«12
Поиск:

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