Добрый вечер. Прошу помочь с макросами. Изначально составила формулы, по которым планировала делать расчеты. Но в файле будет 500000 строк, в итоге целый день шли расчеты, формулы пересчитывались, но так и не пересчитались. Попробовала написать макрос макрорекордером, но быстрее работать не стало. Ниже макрос, пример тоже во вложении. Помогите допилить его , пжлст, чтобы работало быстрее Ну хоть два часа чтобы считалось, а не 8 ))
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 EndSub
Добрый вечер. Прошу помочь с макросами. Изначально составила формулы, по которым планировала делать расчеты. Но в файле будет 500000 строк, в итоге целый день шли расчеты, формулы пересчитывались, но так и не пересчитались. Попробовала написать макрос макрорекордером, но быстрее работать не стало. Ниже макрос, пример тоже во вложении. Помогите допилить его , пжлст, чтобы работало быстрее Ну хоть два часа чтобы считалось, а не 8 ))
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 EndSub
Макрорекордер это так записал? Подскажите, где такой макрорекордер можно найти 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. все формула
Пока писал макрос вместо формул, Медведь обогнал на повороте. Вдруг макрос быстрее формул работать будет
Sub Проверить_Фейс() Dim Sh As Worksheet, key AsString, UU(), key2 AsString, 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")
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)
EndIf
Else Set C = CreateObject("scripting.dictionary")
key2 = dNO(n, 4)
C.Item(dNO(n, 4)) = dNO(n, 5) Set C_Q.Item(key) = C EndIf
Next For n = 2To 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) = 1Then
UU(n, 1) = "проверить фейс"
IsTrue = True EndIf EndIf
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 = 0To C.Count - 1 If keys(i) < dNO(n, 4) Then
Sum = C.Item(keys(i)) + Sum
EndIf
Next EndIf EndIf
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 = 0To 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 ExitFor EndIf
EndIf
Next
EndIf If IsTrue And (IsTrue1 Or IsTrue2) Then
VV(n, 1) = "можно расширить" EndIf Next
Sh.Range("u1").Resize(LastRow, 1) = UU
Sh.Range("v1").Resize(LastRow, 1) = VV EndSub
Пока писал макрос вместо формул, Медведь обогнал на повороте. Вдруг макрос быстрее формул работать будет
Sub Проверить_Фейс() Dim Sh As Worksheet, key AsString, UU(), key2 AsString, 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")
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)
EndIf
Else Set C = CreateObject("scripting.dictionary")
key2 = dNO(n, 4)
C.Item(dNO(n, 4)) = dNO(n, 5) Set C_Q.Item(key) = C EndIf
Next For n = 2To 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) = 1Then
UU(n, 1) = "проверить фейс"
IsTrue = True EndIf EndIf
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 = 0To C.Count - 1 If keys(i) < dNO(n, 4) Then
Sum = C.Item(keys(i)) + Sum
EndIf
Next EndIf EndIf
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 = 0To 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 ExitFor EndIf
EndIf
Next
EndIf If IsTrue And (IsTrue1 Or IsTrue2) Then
VV(n, 1) = "можно расширить" EndIf Next
Sh.Range("u1").Resize(LastRow, 1) = UU
Sh.Range("v1").Resize(LastRow, 1) = VV EndSub
37,5625 но замер я делал на 100 расчетах по 500000 строкам заполненным. Можно предположить что расчет 500000 займет в 5000 раз больше и это неприемлемо.
doober, ну формульный вариант провальный, конечно оптимизация дала свой результат
37,5625 но замер я делал на 100 расчетах по 500000 строкам заполненным. Можно предположить что расчет 500000 займет в 5000 раз больше и это неприемлемо.bmv98rus
Замечательный Временно просто медведь , процентов на 20.
при запуске макроса в тестовом файле, который прикладывала, все работает. Скопировала в этот файл другие строчки (ни заголовки ни порядок столбцов не поменялся) выдаёт ошибку "Subscript out of range". И вот эта строка в макросе подсвечивается жёлтым.
в чем может быть причина ? Приложила файл
If keys(i) > dNO(n, 4) Then
при запуске макроса в тестовом файле, который прикладывала, все работает. Скопировала в этот файл другие строчки (ни заголовки ни порядок столбцов не поменялся) выдаёт ошибку "Subscript out of range". И вот эта строка в макросе подсвечивается жёлтым.
Здравствуйте! Могу предложить следующий вариант решения, обо тоже знаю, что если использовать в vba метод задействования изменения какого-то состояние ячейки, будь то значение, формат и т.д, то ресурс памяти задействуется значительно. Гораздо проще в этом случае использовать массив. Допустим, у нас имеется некий структурированный непрерывный диапазон данных с заголовками, как полагается, располагающийся в диапазоне, начиная с ячейки A2. Это дает нам возможность определить размер нашего массива.
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 DoWhile .Cells(I+1,1).Value<>"" 'Производим анализ If .Cells(I+1,15)Value=1And Application.WorkSeetFunction.CountIfs("условия функции") Then'- вот здесь метод CountIfs, соответствующий Вашей функции СУММЕСЛИМН, нужно заполнить корректными данными
ArrData(I)="проверить фейс" Else
ArrData(I)="" End if Loop 'А дальше просто заполняете нужный Вам диапазон данными массива:
.Range(.Cells(2, 19), .Cells(UBound(ArrData) + 1, 19)).Value = ArrData EndWith
Здравствуйте! Могу предложить следующий вариант решения, обо тоже знаю, что если использовать в vba метод задействования изменения какого-то состояние ячейки, будь то значение, формат и т.д, то ресурс памяти задействуется значительно. Гораздо проще в этом случае использовать массив. Допустим, у нас имеется некий структурированный непрерывный диапазон данных с заголовками, как полагается, располагающийся в диапазоне, начиная с ячейки A2. Это дает нам возможность определить размер нашего массива.
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 DoWhile .Cells(I+1,1).Value<>"" 'Производим анализ If .Cells(I+1,15)Value=1And Application.WorkSeetFunction.CountIfs("условия функции") Then'- вот здесь метод CountIfs, соответствующий Вашей функции СУММЕСЛИМН, нужно заполнить корректными данными
ArrData(I)="проверить фейс" Else
ArrData(I)="" End if Loop 'А дальше просто заполняете нужный Вам диапазон данными массива:
.Range(.Cells(2, 19), .Cells(UBound(ArrData) + 1, 19)).Value = ArrData EndWith
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