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

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

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

Мир MS Excel » Вопросы и решения » Вопросы по VBA » Ускорить работу макроса нахождения кол-ва по трем условиям (Макросы/Sub)

Ускорить работу макроса нахождения кол-ва по трем условиям

_Boroda_

Дата: Среда, 03.08.2016, 13:29 | Сообщение № 21

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

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

Сообщений: 16672

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

Замечаний: 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

Ответить

китин

Дата: Среда, 03.08.2016, 13:55 | Сообщение № 22

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

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

Сообщений: 7014

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

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

Excel 2007;2010;2016

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

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

Ответить

китин

Дата: Среда, 03.08.2016, 14:14 | Сообщение № 23

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

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

Сообщений: 7014

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

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

Excel 2007;2010;2016

а вот теперь ничего не понимаю: малость переделанный код из 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 напрочь с закрытием всех открытых файлов. непонятненько

а вот теперь ничего не понимаю: малость переделанный код из 1 поста
[vba]

Код

китин

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

Ответить

Сообщениеа вот теперь ничего не понимаю: малость переделанный код из 1 поста
[vba]

Код

Автор - китин
Дата добавления - 03.08.2016 в 14:14

Manyasha

Дата: Среда, 03.08.2016, 18:07 | Сообщение № 24

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

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

Сообщений: 2198

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

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

Excel 2010, 2016

Игорь, в файле из 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

Цитата китин, 03.08.2016 в 12:49, в сообщении № 18

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

Цитата китин, 03.08.2016 в 13:22, в сообщении № 20

а какие камни могут быть?

такие, что

Цитата китин, 03.08.2016 в 12:00, в сообщении № 17

мои объемы просчитал за 1,5 минуты

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

ЯД: 410013299366744 WM: R193491431804

Ответить

китин

Дата: Четверг, 04.08.2016, 07:24 | Сообщение № 25

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

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

Сообщений: 7014

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

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

Excel 2007;2010;2016

Спасибо Марина.

Цитата Manyasha, 03.08.2016 в 18:07, в сообщении № 24

15000 в формуле - это с большим запасом?

нет. запас примерно 500-700 строк

Цитата Manyasha, 03.08.2016 в 18:07, в сообщении № 24

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

ну дык и пишу

Цитата китин, 03.08.2016 в 14:14, в сообщении № 23

малость переделанный код из 1 поста

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

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

Ответить

Manyasha

Дата: Четверг, 04.08.2016, 11:04 | Сообщение № 26

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

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

Сообщений: 2198

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

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

Excel 2010, 2016

Я конечно не проверяла, но по логике в формуле с ЕСЛИ(ЕНД считается сначала связка Индекс+Поископоз и, если ошибка, эта же связка считается второй раз.
А если оставить просто Индекс+Поискпоз, а Н/Д-ки удалять так?
[vba]

Код

    Range(Cells(3, 9), Cells(lLastRow, 9)).Select
    Selection.SpecialCells(xlCellTypeFormulas, 16).ClearContents 'эту строчку добавить
    Selection.Copy ' копируем

[/vba]

ЯД: 410013299366744 WM: R193491431804

Ответить

китин

Дата: Понедельник, 31.10.2016, 08:23 | Сообщение № 27

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

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

Сообщений: 7014

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

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

Excel 2007;2010;2016

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

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

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