Страницы: 1
RSS
VBA Как оптимизировать код для большого числа строк?, работа с большими данными
 
Ребят, подскажите, есть код который исправно работает на 100 и 1000 записей, ставлю реестр в 70000, виснет на долгое время, что в принципе логично.
Берем 3 столбца в таблице, запускаем цикл по всем записям и смотрим если такие же столбцы уже есть выше по списку то ставим 0, если это уникальное сочитание столбцов то ставим 1.
Соответственно получается, что чем дальше он вниз по списку идет, тем больше ему приходится перемалывать записей. Что тут можно придумать?
Код
Sub √руппировка_продуктов_за_мес€ц()
Dim id As String
Dim product As String
Dim mouth As String

Dim idCheck As String
Dim productCheck As String
Dim mouthCheck As String

Dim arrayId As Variant
Dim arrayProduct As Variant
Dim arrayMouth As Variant

SheetName = "list1"

lastRow = Sheets(SheetName).Cells(Rows.Count, "U").End(xlUp).Row

arrayId = Range("U2:U" & lastRow).Value
arrayProduct = Range("DU2:DU" & lastRow).Value
arrayMouth = Range("EI2:EI" & lastRow).Value

For i = 1 To lastRow - 1
    id = arrayId(i, 1)
    product = arrayProduct(i, 1)
    mouth = arrayMouth(i, 1)
    Sheets(SheetName).Cells(i + 1, "EJ").Value = 1

    For j = 1 To i - 1
        idCheck = arrayId(j, 1)
        productCheck = arrayProduct(j, 1)
        mouthCheck = arrayMouth(j, 1)
        If (id = idCheck AND product=productCheck AND mouth = nouthCheck) Then
            Sheets(SheetName).Cells(i + 1, "EJ").Value = 0
            Exit For
        End If
    Next

Next

End Sub
 
1. если используете массивы - зачем перебираете ячейки? Заполняйте тоже через массив.
2. строку с AND перепишите на вложенные if-then, наиболее частое несовпадение есть смысл проверять первым.
 
Пример где?
Я сам - дурнее всякого примера! ...
 
сильно не вникал, но поставьте в начало кода отключение обновления экрана, включите ручной пересчет формул.  В конце кода включите обновление экрана и включите автоматический пересчет формул. Должно немного помочь.
Код
sub такой то

Application.ScreenUpdating = False
     Application.DisplayAlerts = False
      Application.EnableEvents = False
       Application.Calculation = xlManual

ПИШЕМ КОД

Application.ScreenUpdating = True
     Application.DisplayAlerts = True
      Application.EnableEvents = True
      Application.Calculation = xlAutomatic
End sub
Изменено: alexthegreat - 11.04.2016 09:12:48
 
Цитата
Hugo написал:
1. если используете массивы - зачем перебираете ячейки? Заполняйте тоже через массив.
2. строку с AND перепишите на вложенные if-then, наиболее частое несовпадение есть смысл проверять первым.
Сделал по рекомендациям, время минуты на 2 сократилось! Спасибо! 60000 строк минуты 3 маслает

Думал просто есть принципиально другой подход к решению такой задачи, а не тупым перебором по всем записям, как сделал я :)
 
А если сцепить эти 3 столбца, потом натравить условное форматирование, отфильтровать, проставить 1. Это будет не быстрее 3 минут?  
 
70 тыс. строк меньше секунды

з.ы. Данные в файл нужно внести
 
Не совсем в тему. Бывает что уже оптимизировано всё что можно, но из-за большого количества данных процедура всё равно выполняется довольно долго, тогда я вставляю полосу прогресса - пользователь наглядно видит что процесс движется и не переживает что комп завис.
Не стреляйте в тапера - он играет как может.
Страницы: 1
Наверх