Добрый вечер. Прошу помочь с макросами. Изначально составила формулы, по которым планировала делать расчеты. Но в файле будет 500000 строк, в итоге целый день шли расчеты, формулы пересчитывались, но так и не пересчитались. Попробовала написать макрос макрорекордером, но быстрее работать не стало. Ниже макрос, пример тоже во вложении. Помогите допилить его , пжлст, чтобы работало быстрее Ну хоть два часа чтобы считалось, а не 8 ))
[vba]
Код
Sub Расшир() ActiveCell.FormulaR1C1 = _ "=IF(AND(RC[-3]=""проверить фейс"",OR(COUNTIFS(C2,RC2,C4,RC4,C17,"">=""&RC17,C3,RC3,C14,"">=2"")>0,SUMIFS(C18,C2,RC2,C4,RC4,C3,RC3,C17,""<""&RC17)>=RC17)),""можно расширить"","""")" Selection.AutoFill Destination:=Range("V2:V34"), Type:=xlFillDefault Range("V2:V34").Select Dim smallrng As Range For Each smallrng In Selection.Areas smallrng.Value = smallrng.Value Next smallrng End Sub
[/vba]
Добрый вечер. Прошу помочь с макросами. Изначально составила формулы, по которым планировала делать расчеты. Но в файле будет 500000 строк, в итоге целый день шли расчеты, формулы пересчитывались, но так и не пересчитались. Попробовала написать макрос макрорекордером, но быстрее работать не стало. Ниже макрос, пример тоже во вложении. Помогите допилить его , пжлст, чтобы работало быстрее Ну хоть два часа чтобы считалось, а не 8 ))
[vba]
Код
Sub Расшир() ActiveCell.FormulaR1C1 = _ "=IF(AND(RC[-3]=""проверить фейс"",OR(COUNTIFS(C2,RC2,C4,RC4,C17,"">=""&RC17,C3,RC3,C14,"">=2"")>0,SUMIFS(C18,C2,RC2,C4,RC4,C3,RC3,C17,""<""&RC17)>=RC17)),""можно расширить"","""")" Selection.AutoFill Destination:=Range("V2:V34"), Type:=xlFillDefault Range("V2:V34").Select Dim smallrng As Range For Each smallrng In Selection.Areas smallrng.Value = smallrng.Value Next smallrng End Sub
Макрорекордер это так записал? Подскажите, где такой макрорекордер можно найти 1. Для ускорения: проверьте файл на лишнее (УФ и обычное форматирование и объекты) и удалите лишнее (например, у Вас до конца листа заливка по столбцам, а в рабочем файле возможно и еще что-то есть). Для этого наберите в поисковике "как уменьшить размер файла Excel" 2. Если не поможет опишите то, что должны делать Ваши формулы (какой из чего результат должен появиться в конкретных ячейках) 3. Вместо AutoFill можно использовать Range(такой-то)=формула такая-то. Тогда формула вставится сразу в весь диапазон а не по очереди в каждую ячейку.
Макрорекордер это так записал? Подскажите, где такой макрорекордер можно найти 1. Для ускорения: проверьте файл на лишнее (УФ и обычное форматирование и объекты) и удалите лишнее (например, у Вас до конца листа заливка по столбцам, а в рабочем файле возможно и еще что-то есть). Для этого наберите в поисковике "как уменьшить размер файла Excel" 2. Если не поможет опишите то, что должны делать Ваши формулы (какой из чего результат должен появиться в конкретных ячейках) 3. Вместо AutoFill можно использовать Range(такой-то)=формула такая-то. Тогда формула вставится сразу в весь диапазон а не по очереди в каждую ячейку._Igor_61
Вместо AutoFill можно использовать Range(такой-то)=формула такая-то
Я всегда тоже так делала, но не так давно столкнулась с ситуацией, когда надо было заполнить формулой порядка 50 000 строк. Была удивлена, что AutoFill справился значительно быстрее.
Вместо AutoFill можно использовать Range(такой-то)=формула такая-то
Я всегда тоже так делала, но не так давно столкнулась с ситуацией, когда надо было заполнить формулой порядка 50 000 строк. Была удивлена, что AutoFill справился значительно быстрее.Pelena
"Черт возьми, Холмс! Но как??!!" Ю-money 41001765434816
который обсчитывает остальные 500 000 строк. В отличии от SUMIFS/SUMIF и даже от COUNTIF он не ограничивает область используемой и работает дольше. То есть нужно ограничит диапазон 2. все формула
который обсчитывает остальные 500 000 строк. В отличии от SUMIFS/SUMIF и даже от COUNTIF он не ограничивает область используемой и работает дольше. То есть нужно ограничит диапазон 2. все формула
Пока писал макрос вместо формул, Медведь обогнал на повороте. Вдруг макрос быстрее формул работать будет
[vba]
Код
Sub Проверить_Фейс() Dim Sh As Worksheet, key As String, UU(), key2 As String, VV() Set Sh = ActiveSheet Set C_is = CreateObject("scripting.dictionary") Set C_Q = CreateObject("scripting.dictionary")
Set C_BDQ = CreateObject("scripting.dictionary") Set C_CN = CreateObject("scripting.dictionary")
LastRow = Sh.Cells(Sh.Rows.Count, 3).End(xlUp).Row BCD = Sh.Range("B1").Resize(LastRow, 3) dNO = Sh.Range("N1").Resize(LastRow, 5) ReDim UU(1 To LastRow, 1 To 1) UU(1, 1) = "Макрос проверить фейс" ReDim VV(1 To LastRow, 1 To 1) VV(1, 1) = "Макрос Можно расширить"
For n = 2 To LastRow
If dNO(n, 1) > 1 Then key = BCD(n, 1) & "_" & BCD(n, 2) & "_" & BCD(n, 3) If Not C_is.Exists(key) Then C_is.Item(key) = 1 End If key1 = BCD(n, 2) & "_" & dNO(n, 4) If Not C_CN.Exists(key1) Then C_CN.Item(key1) = 1
End If
End If
key = BCD(n, 1) & "_" & BCD(n, 3) If C_BDQ.Exists(key) Then Set C = C_BDQ.Item(key)
If C.Exists(dNO(n, 4)) Then C.Item(dNO(n, 4)) = C.Item(dNO(n, 4)) + 1 Else C.Item(dNO(n, 4)) = 1
End If
Else Set C = CreateObject("scripting.dictionary") C.Item(dNO(n, 4)) = 1 Set C_BDQ.Item(key) = C End If
If C.Exists(dNO(n, 4)) Then C.Item(dNO(n, 4)) = C.Item(dNO(n, 4)) + dNO(n, 5) Else C.Item(dNO(n, 4)) = dNO(n, 5)
End If
Else Set C = CreateObject("scripting.dictionary") key2 = dNO(n, 4) C.Item(dNO(n, 4)) = dNO(n, 5) Set C_Q.Item(key) = C End If
Next For n = 2 To LastRow IsTrue = False IsTrue1 = False IsTrue2 = False key = BCD(n, 1) & "_" & BCD(n, 2) & "_" & BCD(n, 3) If C_is.Exists(key) Then If dNO(n, 2) = 1 Then UU(n, 1) = "проверить фейс" IsTrue = True End If End If key = BCD(n, 1) & "_" & BCD(n, 2) & "_" & BCD(n, 3) Sum = 0 If C_Q.Exists(key) Then Set C = C_Q.Item(key)
If C.Exists(dNO(n, 4)) Then keys = C.keys
For i = 0 To C.Count - 1 If keys(i) < dNO(n, 4) Then Sum = C.Item(keys(i)) + Sum
End If
Next End If End If IsTrue1 = Sum >= dNO(n, 4) key1 = BCD(n, 1) & "_" & BCD(n, 3) If C_BDQ.Exists(key1) Then Set C = C_BDQ.Item(key1) For i = 0 To C.Count - 1 If keys(i) > dNO(n, 4) Then key0 = BCD(n, 2) & "_" & dNO(n, 4) If C_CN.Exists(key0) Then IsTrue2 = True Exit For End If
End If
Next
End If If IsTrue And (IsTrue1 Or IsTrue2) Then VV(n, 1) = "можно расширить" End If Next Sh.Range("u1").Resize(LastRow, 1) = UU Sh.Range("v1").Resize(LastRow, 1) = VV End Sub
[/vba]
Пока писал макрос вместо формул, Медведь обогнал на повороте. Вдруг макрос быстрее формул работать будет
[vba]
Код
Sub Проверить_Фейс() Dim Sh As Worksheet, key As String, UU(), key2 As String, VV() Set Sh = ActiveSheet Set C_is = CreateObject("scripting.dictionary") Set C_Q = CreateObject("scripting.dictionary")
Set C_BDQ = CreateObject("scripting.dictionary") Set C_CN = CreateObject("scripting.dictionary")
LastRow = Sh.Cells(Sh.Rows.Count, 3).End(xlUp).Row BCD = Sh.Range("B1").Resize(LastRow, 3) dNO = Sh.Range("N1").Resize(LastRow, 5) ReDim UU(1 To LastRow, 1 To 1) UU(1, 1) = "Макрос проверить фейс" ReDim VV(1 To LastRow, 1 To 1) VV(1, 1) = "Макрос Можно расширить"
For n = 2 To LastRow
If dNO(n, 1) > 1 Then key = BCD(n, 1) & "_" & BCD(n, 2) & "_" & BCD(n, 3) If Not C_is.Exists(key) Then C_is.Item(key) = 1 End If key1 = BCD(n, 2) & "_" & dNO(n, 4) If Not C_CN.Exists(key1) Then C_CN.Item(key1) = 1
End If
End If
key = BCD(n, 1) & "_" & BCD(n, 3) If C_BDQ.Exists(key) Then Set C = C_BDQ.Item(key)
If C.Exists(dNO(n, 4)) Then C.Item(dNO(n, 4)) = C.Item(dNO(n, 4)) + 1 Else C.Item(dNO(n, 4)) = 1
End If
Else Set C = CreateObject("scripting.dictionary") C.Item(dNO(n, 4)) = 1 Set C_BDQ.Item(key) = C End If
If C.Exists(dNO(n, 4)) Then C.Item(dNO(n, 4)) = C.Item(dNO(n, 4)) + dNO(n, 5) Else C.Item(dNO(n, 4)) = dNO(n, 5)
End If
Else Set C = CreateObject("scripting.dictionary") key2 = dNO(n, 4) C.Item(dNO(n, 4)) = dNO(n, 5) Set C_Q.Item(key) = C End If
Next For n = 2 To LastRow IsTrue = False IsTrue1 = False IsTrue2 = False key = BCD(n, 1) & "_" & BCD(n, 2) & "_" & BCD(n, 3) If C_is.Exists(key) Then If dNO(n, 2) = 1 Then UU(n, 1) = "проверить фейс" IsTrue = True End If End If key = BCD(n, 1) & "_" & BCD(n, 2) & "_" & BCD(n, 3) Sum = 0 If C_Q.Exists(key) Then Set C = C_Q.Item(key)
If C.Exists(dNO(n, 4)) Then keys = C.keys
For i = 0 To C.Count - 1 If keys(i) < dNO(n, 4) Then Sum = C.Item(keys(i)) + Sum
End If
Next End If End If IsTrue1 = Sum >= dNO(n, 4) key1 = BCD(n, 1) & "_" & BCD(n, 3) If C_BDQ.Exists(key1) Then Set C = C_BDQ.Item(key1) For i = 0 To C.Count - 1 If keys(i) > dNO(n, 4) Then key0 = BCD(n, 2) & "_" & dNO(n, 4) If C_CN.Exists(key0) Then IsTrue2 = True Exit For End If
End If
Next
End If If IsTrue And (IsTrue1 Or IsTrue2) Then VV(n, 1) = "можно расширить" End If Next Sh.Range("u1").Resize(LastRow, 1) = UU Sh.Range("v1").Resize(LastRow, 1) = VV End Sub
37,5625 но замер я делал на 100 расчетах по 500000 строкам заполненным. Можно предположить что расчет 500000 займет в 5000 раз больше и это неприемлемо.
doober, ну формульный вариант провальный, конечно оптимизация дала свой результат
37,5625 но замер я делал на 100 расчетах по 500000 строкам заполненным. Можно предположить что расчет 500000 займет в 5000 раз больше и это неприемлемо.bmv98rus
Замечательный Временно просто медведь , процентов на 20.
при запуске макроса в тестовом файле, который прикладывала, все работает. Скопировала в этот файл другие строчки (ни заголовки ни порядок столбцов не поменялся) выдаёт ошибку "Subscript out of range". И вот эта строка в макросе подсвечивается жёлтым.
в чем может быть причина ? Приложила файл
[vba]
Код
If keys(i) > dNO(n, 4) Then
[/vba]
при запуске макроса в тестовом файле, который прикладывала, все работает. Скопировала в этот файл другие строчки (ни заголовки ни порядок столбцов не поменялся) выдаёт ошибку "Subscript out of range". И вот эта строка в макросе подсвечивается жёлтым.
Здравствуйте! Могу предложить следующий вариант решения, обо тоже знаю, что если использовать в vba метод задействования изменения какого-то состояние ячейки, будь то значение, формат и т.д, то ресурс памяти задействуется значительно. Гораздо проще в этом случае использовать массив. Допустим, у нас имеется некий структурированный непрерывный диапазон данных с заголовками, как полагается, располагающийся в диапазоне, начиная с ячейки A2. Это дает нам возможность определить размер нашего массива. [vba]
Код
Option Base 1 With ThisWorkBook.WorkSheets("Название обрабатываемого листа") Dim ArrData() as Variant, I as Long ReDim ArrData(.Cells(1, 1).CurrentRegoin.Rows.Count - 1) 'Запускаем цикл заполнения массива данными, где мы используем объект Application.WorkSeetFunction I=1 Do While .Cells(I+1,1).Value<>"" 'Производим анализ If .Cells(I+1,15)Value=1 And Application.WorkSeetFunction.CountIfs("условия функции") Then '- вот здесь метод CountIfs, соответствующий Вашей функции СУММЕСЛИМН, нужно заполнить корректными данными ArrData(I)="проверить фейс" Else ArrData(I)="" End if Loop 'А дальше просто заполняете нужный Вам диапазон данными массива: .Range(.Cells(2, 19), .Cells(UBound(ArrData) + 1, 19)).Value = ArrData End With
[/vba]
Здравствуйте! Могу предложить следующий вариант решения, обо тоже знаю, что если использовать в vba метод задействования изменения какого-то состояние ячейки, будь то значение, формат и т.д, то ресурс памяти задействуется значительно. Гораздо проще в этом случае использовать массив. Допустим, у нас имеется некий структурированный непрерывный диапазон данных с заголовками, как полагается, располагающийся в диапазоне, начиная с ячейки A2. Это дает нам возможность определить размер нашего массива. [vba]
Код
Option Base 1 With ThisWorkBook.WorkSheets("Название обрабатываемого листа") Dim ArrData() as Variant, I as Long ReDim ArrData(.Cells(1, 1).CurrentRegoin.Rows.Count - 1) 'Запускаем цикл заполнения массива данными, где мы используем объект Application.WorkSeetFunction I=1 Do While .Cells(I+1,1).Value<>"" 'Производим анализ If .Cells(I+1,15)Value=1 And Application.WorkSeetFunction.CountIfs("условия функции") Then '- вот здесь метод CountIfs, соответствующий Вашей функции СУММЕСЛИМН, нужно заполнить корректными данными ArrData(I)="проверить фейс" Else ArrData(I)="" End if Loop 'А дальше просто заполняете нужный Вам диапазон данными массива: .Range(.Cells(2, 19), .Cells(UBound(ArrData) + 1, 19)).Value = ArrData End With
Chula7094, Если следовать задумке ТС, то и ваш метод можно использовать, но я наглядно показал, что на объеме значений функции листа становятся не столь стремительными и они не станут быстрее от применения не на лист а в коде.
Chula7094, Если следовать задумке ТС, то и ваш метод можно использовать, но я наглядно показал, что на объеме значений функции листа становятся не столь стремительными и они не станут быстрее от применения не на лист а в коде.bmv98rus
Замечательный Временно просто медведь , процентов на 20.
Добрый день Начала работать в этом файле с макросом, а он не верно считает данные. По формуле одни данные, макрос - немного отличаются. doober, можете помочь ? Пожалуйста
Добрый день Начала работать в этом файле с макросом, а он не верно считает данные. По формуле одни данные, макрос - немного отличаются. doober, можете помочь ? Пожалуйстаnikonka_muss
Здравствуйте. Смогу, только опишите логику получения данных. Только на формулы не опирайтесь, своими словами. Я пытался адаптировать , как считает формула, мог и ошибиться или что то не учел
Здравствуйте. Смогу, только опишите логику получения данных. Только на формулы не опирайтесь, своими словами. Я пытался адаптировать , как считает формула, мог и ошибиться или что то не учелdoober
Колонка true (СТМ) - эти позиции должны быть по 2 шт минимум. В идеале. Колонка ЛОЖЬ - количество по остальным позициям, за счет которых я могу увеличить СТМ. Проверить фейс - я смотрю по определенной группе, внутри полки, есть ли где СТМ 1 штука, при этом ЛОЖЬ - больше 1. Можно расширить - по тем позициям, по которым выяснили, что нужно проверить фейс, смотрим есть ли возможность поставить не 1, а 2 штуки, за счет позиций из колонки ЛОЖЬ. Для этого я по ширине пытаюсь понять хватит ли мне места, так как у всех позиций ширина разная. Вот например, позиция стм 5 см (1 шт), а другая обычная (ложь) - 3 см (2 шт). И за счет уменьшения ее, все равно стм не увеличить, места не хватит. А там где места хватает - коммент можно расширить
Колонка true (СТМ) - эти позиции должны быть по 2 шт минимум. В идеале. Колонка ЛОЖЬ - количество по остальным позициям, за счет которых я могу увеличить СТМ. Проверить фейс - я смотрю по определенной группе, внутри полки, есть ли где СТМ 1 штука, при этом ЛОЖЬ - больше 1. Можно расширить - по тем позициям, по которым выяснили, что нужно проверить фейс, смотрим есть ли возможность поставить не 1, а 2 штуки, за счет позиций из колонки ЛОЖЬ. Для этого я по ширине пытаюсь понять хватит ли мне места, так как у всех позиций ширина разная. Вот например, позиция стм 5 см (1 шт), а другая обычная (ложь) - 3 см (2 шт). И за счет уменьшения ее, все равно стм не увеличить, места не хватит. А там где места хватает - коммент можно расширитьnikonka_muss
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
Я руками больше 2-х не набиваю никогда, ленивый очень
