Оптимизация цикла при обработке таблицы Excel

@Olegplita · Регистрация: 29.10.2014

Author24 — интернет-сервис помощи студентам

Добрый день, прошу помощи. Программирую недавно дней 7-8 )))).
есть таблица Excel 50 тыс строк
цикл с 1 до последней строки, значение 3 столбца может быть одно из 50
происходит проверка так
-если значение в столбце 3 равно Значение 1 тогда определенным образом корректируется значение в стобце 9 той же строки
-если значение в столбце 3 равно Значение 2 тогда определенным образом корректируется значение в стобце 9 той же строки
-если значение в столбце 3 равно Значение 3 тогда определенным образом корректируется значение в стобце 9 той же строки
и так 28 раз

однако значение в столбце 3 может принимать только 1 значение (извините за тафтологию). поэтому дальнейшие проверки этой ячейки теряют смысл.
сейчас программа обрабатывает таблицу за 28 минут, что долго.

помогите примером кода или указанием что необходимо почитать.
Заранее благодарен.

@~~Апострофф~~ · 06.11.2014, 21:37

Сообщение от Olegplita

помогите примером кода или указанием что необходимо почитать.

Приложите ваш пример таблицы и ожидаемый результат - https://www.cyberforum.ru/abou... 03521.html

@Alex77755 · 06.11.2014, 23:48

Visual Basic

1	есть таблица Excel 50 тыс строк

Лучше сразу считать в массив. Примерно так:

Visual Basic

With Лист1
    LR = .Cells(.Rows.Count, 1).End(xlUp).Row
    M = .Range("A1").Resize(LR,10)
    For R = 1 To LR 
        If  M(R, 1) = "Значение 1" Then
             M(R, 1) = определенным образом корректируется значение
        End If
    Next R
End With

@Hugo121 · 07.11.2014, 17:40

Сперва набиваем словарь значениями и как корректировать (можно прямо в коде, можно брать список из любого файла), затем при цикле по массиву берём из словаря нужную коррекцию. Быстро.

@mc-black · 07.11.2014, 18:01

Да, очень ускорило бы чтение сразу в массив. Сам набор из кучи условий лучше слегка переписать, вместо множество выражений if ... then сделать одну конструкцию Select Case:

Visual Basic

Select Case .Cells(i,3)
    Case "Значение 1":
        ' Действие 1
    Case "Значение 2":
        ' Действие 2
    ' и так далее
    Case "Значение 27":
        ' Действие 27
    Case Else
        ' Действие, если встретилось неожиданное значение
End Select

Добавлено через 6 минут
Hugo121, хотя я и давно знаком с VBA, стыдно сознаться, но до сих пор у меня большие трудности при работе с "Scripting.Dictionary". Никак не могу себя пересилить и научиться мыслить категориями этого объекта, свободно без напрягов решать с его помощью свои задачи. И когда им пользоваться эффективней, чем прямыми средствами языка? Есть какой-нибудь мануал, чтобы привыкнуть и полюбить его? Из-за этого мне кажется, что решение на словаре будет трудным для новичка. Возможно, я не прав.

@Alex77755 · 07.11.2014, 20:26

Visual Basic

1	Select Case .Cells(i,3)

не оптимально при большом количестве строк!

Visual Basic

1	Select Case M(i,3)

Так значительно быстрей
Естественно предварительно считав в массив

@Alex77755 · 07.11.2014, 20:31

Есть какой-нибудь мануал

коротко...

@Alex77755 · 07.11.2014, 20:34

в случае примененеия словаря Select Case со всеми Case можно будет заменить одной строкой:

Visual Basic

1	M(i,9) = DS(M(R, 3))

Где DS словарь, заполненный правилами

@Olegplita · 07.11.2014, 20:46 **[ТС]**

Так выглядит основная часть кода

Visual Basic

 i = FirstRow
        Do Until i = lastRow + 1
            Label3.Text = i & " ИЗ " & lastRow
            ''Бренды в которых убираем 2 знака сначала строки
            If exl.Sheets(1).Range("C" & i).Value = "ADRIAUTO" Then exl.Sheets(1).Range("A" & i).Value = exl.Sheets(1).Range("A" & i).Value.Substring(2, Len(exl.Sheets(1).Range("A" & i).Value) - '2)
            If exl.Sheets(1).Range("C" & i).Value = "CORTECO" Then exl.Sheets(1).Range("A" & i).Value = exl.Sheets(1).Range("A" & i).Value.Substring(2, Len(exl.Sheets(1).Range("A" & i).Value) - 2)
            If exl.Sheets(1).Range("C" & i).Value = "FEBI" Then exl.Sheets(1).Range("A" & i).Value = exl.Sheets(1).Range("A" & i).Value.Substring(2, Len(exl.Sheets(1).Range("A" & i).Value) - 2)
            If exl.Sheets(1).Range("C" & i).Value = "FORD" Then exl.Sheets(1).Range("A" & i).Value = exl.Sheets(1).Range("A" & i).Value.Substring(2, Len(exl.Sheets(1).Range("A" & i).Value) - 2)
            If exl.Sheets(1).Range("C" & i).Value = "VALEO" Then exl.Sheets(1).Range("A" & i).Value = exl.Sheets(1).Range("A" & i).Value.Substring(2, Len(exl.Sheets(1).Range("A" & i).Value) - 2)
            If exl.Sheets(1).Range("C" & i).Value = "WAHLER" Then exl.Sheets(1).Range("A" & i).Value = exl.Sheets(1).Range("A" & i).Value.Substring(2, Len(exl.Sheets(1).Range("A" & i).Value) - 2)
            ''Бренды в которых убираем 3 знака сначала строки
            If exl.Sheets(1).Range("C" & i).Value = "GATES" Then exl.Sheets(1).Range("A" & i).Value = exl.Sheets(1).Range("A" & i).Value.Substring(3, Len(exl.Sheets(1).Range("A" & i).Value) - 3)
            If exl.Sheets(1).Range("C" & i).Value = "FAE" Then exl.Sheets(1).Range("A" & i).Value = exl.Sheets(1).Range("A" & i).Value.Substring(3, Len(exl.Sheets(1).Range("A" & i).Value) - 3)
            If exl.Sheets(1).Range("C" & i).Value = "ERT" Then exl.Sheets(1).Range("A" & i).Value = exl.Sheets(1).Range("A" & i).Value.Substring(3, Len(exl.Sheets(1).Range("A" & i).Value) - 3)
            If exl.Sheets(1).Range("C" & i).Value = "Elring" Then exl.Sheets(1).Range("A" & i).Value = exl.Sheets(1).Range("A" & i).Value.Substring(3, Len(exl.Sheets(1).Range("A" & i).Value) - 3)
            If exl.Sheets(1).Range("C" & i).Value = "DOLZ" Then exl.Sheets(1).Range("A" & i).Value = exl.Sheets(1).Range("A" & i).Value.Substring(3, Len(exl.Sheets(1).Range("A" & i).Value) - 3)
            If exl.Sheets(1).Range("C" & i).Value = "DAYCO" Then exl.Sheets(1).Range("A" & i).Value = exl.Sheets(1).Range("A" & i).Value.Substring(3, Len(exl.Sheets(1).Range("A" & i).Value) - 3)
            If exl.Sheets(1).Range("C" & i).Value = "FISCHER" Then exl.Sheets(1).Range("A" & i).Value = exl.Sheets(1).Range("A" & i).Value.Substring(3, Len(exl.Sheets(1).Range("A" & i).Value) - 3)
            If exl.Sheets(1).Range("C" & i).Value = "Lemforder" Then exl.Sheets(1).Range("A" & i).Value = exl.Sheets(1).Range("A" & i).Value.Substring(3, Len(exl.Sheets(1).Range("A" & i).Value) - '3)
            If exl.Sheets(1).Range("C" & i).Value = "LPR" Then exl.Sheets(1).Range("A" & i).Value = exl.Sheets(1).Range("A" & i).Value.Substring(3, Len(exl.Sheets(1).Range("A" & i).Value) - 3)
            If exl.Sheets(1).Range("C" & i).Value = "Monroe" Then exl.Sheets(1).Range("A" & i).Value = exl.Sheets(1).Range("A" & i).Value.Substring(3, Len(exl.Sheets(1).Range("A" & i).Value) - 3)
            If exl.Sheets(1).Range("C" & i).Value = "NARVA" Then exl.Sheets(1).Range("A" & i).Value = exl.Sheets(1).Range("A" & i).Value.Substring(3, Len(exl.Sheets(1).Range("A" & i).Value) - 3)
            If exl.Sheets(1).Range("C" & i).Value = "Osram" Then exl.Sheets(1).Range("A" & i).Value = exl.Sheets(1).Range("A" & i).Value.Substring(3, Len(exl.Sheets(1).Range("A" & i).Value) - 3)
            If exl.Sheets(1).Range("C" & i).Value = "PHILIPS" Then exl.Sheets(1).Range("A" & i).Value = exl.Sheets(1).Range("A" & i).Value.Substring(3, Len(exl.Sheets(1).Range("A" & i).Value) - 3)
            If exl.Sheets(1).Range("C" & i).Value = "Purflux" Then exl.Sheets(1).Range("A" & i).Value = exl.Sheets(1).Range("A" & i).Value.Substring(3, Len(exl.Sheets(1).Range("A" & i).Value) - 3)
            If exl.Sheets(1).Range("C" & i).Value = "Ruville" Then exl.Sheets(1).Range("A" & i).Value = exl.Sheets(1).Range("A" & i).Value.Substring(3, Len(exl.Sheets(1).Range("A" & i).Value) - 3)
            If exl.Sheets(1).Range("C" & i).Value = "SASIC" Then exl.Sheets(1).Range("A" & i).Value = exl.Sheets(1).Range("A" & i).Value.Substring(3, Len(exl.Sheets(1).Range("A" & i).Value) - 3)
            If exl.Sheets(1).Range("C" & i).Value = "TEXTAR" Then exl.Sheets(1).Range("A" & i).Value = exl.Sheets(1).Range("A" & i).Value.Substring(3, Len(exl.Sheets(1).Range("A" & i).Value) - 3)
            If exl.Sheets(1).Range("C" & i).Value = "BOSAL" Then exl.Sheets(1).Range("A" & i).Value = exl.Sheets(1).Range("A" & i).Value.Substring(3, Len(exl.Sheets(1).Range("A" & i).Value) - 3)
            If exl.Sheets(1).Range("C" & i).Value = "AJUSA" Then exl.Sheets(1).Range("A" & i).Value = exl.Sheets(1).Range("A" & i).Value.Substring(3, Len(exl.Sheets(1).Range("A" & i).Value) - 3)
            ''Бренды в которых убираем 4 знака сначала строки
            If exl.Sheets(1).Range("C" & i).Value = "AIRTEX" Then exl.Sheets(1).Range("A" & i).Value = exl.Sheets(1).Range("A" & i).Value.Substring(4, Len(exl.Sheets(1).Range("A" & i).Value) - 4)
            If exl.Sheets(1).Range("C" & i).Value = "AISIN" Then exl.Sheets(1).Range("A" & i).Value = exl.Sheets(1).Range("A" & i).Value.Substring(4, Len(exl.Sheets(1).Range("A" & i).Value) - 4)
            If exl.Sheets(1).Range("C" & i).Value = "NISSENS" Then exl.Sheets(1).Range("A" & i).Value = exl.Sheets(1).Range("A" & i).Value.Substring(4, Len(exl.Sheets(1).Range("A" & i).Value) - 4)
            ''проверка бренда EPS 
            If exl.Sheets(1).Range("C" & i).Value = "FACET" And InStr(exl.Sheets(1).Range("A" & i).Value, "EPS", ) = 1 Then exl.Sheets(1).Range("A" & i).Value = exl.Sheets(1).Range("A" & i).Value.Substring(4, Len(exl.Sheets(1).Range("A" & i).Value) - 4)
            i = i + 1
        Loop
        exl.Visible = True

проблема в том что 1 и ту же ячейку сканирует много раз даже если она уже "отработана"

@Alex77755 · 07.11.2014, 23:27

Так примерно выглядит вся процедура.
Возможно где-то что-то не досмотрел - извините праздник!

Visual Basic

Sub QWERT()
    Dim M(), LR, S(), T, R, D: Set D = CreateObject("Scripting.Dictionary")
    S = Array("ADRIAUTO", "CORTECO", "FEBI", "FORD", "VALEO", "WAHLER")
    For R = 0 To UBound(S): D(S(R)) = 2: Next
    S = Array("GATES", "FAE", "ERT", "Elring", "DOLZ", "DAYCO", "FISCHER", "Lemforder", "LPR", "Monroe", "NARVA", "Osram", "PHILIPS", "Purflux", "Ruville", "SASIC", "TEXTAR", "BOSAL", "AJUSA")
    For R = 0 To UBound(S): D(S(R)) = 3: Next
    S = Array("AIRTEX", "AISIN", "NISSENS")
    For R = 0 To UBound(S): D(S(R)) = 4: Next
    D("FACET" & "|" & "EPS") = 4
    
    With Лист1
        LR = .Cells(.Rows.Count, 1).End(xlUp).Row
        M = .Range("A8").Resize(LR + 8, 3)
    End With
    For R = 3 To UBound(M)
    T = M(R, 3) & "|" & Left(M(R, 1), 3)
        If D.exists(T) Then
            M(R, 1) = Trim(Mid(M(R, 1), D(T)))
        Else
           If D.exists(M(R, 3)) Then M(R, 1) = Trim(Mid(M(R, 1), D(M(R, 3))))
        End If
    Next R
    Worksheets.Add
    Range("A8").Resize(LR + 8, 3) = M
End Sub

Добавлено через 6 минут

проблема в том что 1 и ту же ячейку

Четвёртый раз повторяюсь!
Не надо при больших объёмах "сканировать" ячейки!
Это один из самых медленных процессов!
Надо делать всё в массивах!

Добавлено через 5 минут
Resize(LR + 8) - возможно тут не много "погорячился".
Похоже достаточно Resize(LR - 7)

@Olegplita 0 / 0 / 0 Регистрация: 29.10.2014 Сообщений: 2
		1
	Оптимизация цикла при обработке таблицы Excel 06.11.2014, 21:15. Показов 3572. Ответов 9 Метки нет (Все метки) Добрый день, прошу помощи. Программирую недавно дней 7-8 )))). есть таблица Excel 50 тыс строк цикл с 1 до последней строки, значение 3 столбца может быть одно из 50 происходит проверка так -если значение в столбце 3 равно Значение 1 тогда определенным образом корректируется значение в стобце 9 той же строки -если значение в столбце 3 равно Значение 2 тогда определенным образом корректируется значение в стобце 9 той же строки -если значение в столбце 3 равно Значение 3 тогда определенным образом корректируется значение в стобце 9 той же строки и так 28 раз однако значение в столбце 3 может принимать только 1 значение (извините за тафтологию). поэтому дальнейшие проверки этой ячейки теряют смысл. сейчас программа обрабатывает таблицу за 28 минут, что долго. помогите примером кода или указанием что необходимо почитать. Заранее благодарен. 0

@~~Апострофф~~ Заблокирован
	06.11.2014, 21:37	2
	Сообщение от Olegplita помогите примером кода или указанием что необходимо почитать. Приложите ваш пример таблицы и ожидаемый результат - https://www.cyberforum.ru/abou... 03521.html 0

@Hugo121 6944 / 2849 / 548 Регистрация: 19.10.2012 Сообщений: 8,721
	07.11.2014, 17:40	4
	Сперва набиваем словарь значениями и как корректировать (можно прямо в коде, можно брать список из любого файла), затем при цикле по массиву берём из словаря нужную коррекцию. Быстро. 1

Оптимизация цикла при обработке таблицы Excel

Решение