Оптимизация кода

[blackeangel]

Доброго дня всем. Скажите, пожалуйста, как можно этот код оптимизировать?

Do While Cells(i, Ncolumn2).Value <> Empty 'поставил на "Обозначение" т.к. обрывался на пустой ячейке
objRegExp.Pattern = "^5085"
If objRegExp.Test(Cells(i, ncolumn).Value) = True Then
Cells(i, ncolumn + 1).Value = "С85"
Else
objRegExp.Pattern = "^5081"
If objRegExp.Test(Cells(i, ncolumn).Value) = True Then
Cells(i, ncolumn + 1).Value = "С81"
Else
If Cells(i, ncolumn).Value Like "*3200*" Then
Cells(i, ncolumn + 1).Value = "ЦВО"
Else
objRegExp.Pattern = "^3200-3000"
If objRegExp.Test(Cells(i, ncolumn).Value) = True Or Cells(i, ncolumn).Value Like "*3000*" Or Cells(i, ncolumn).Value Like "*ЭМЦ*" Or Cells(i, Ncolumn2).Value Like "КРП.*.3000*" And Cells(i, ncolumn4).Value Like "Бирка *" Then
Cells(i, ncolumn + 1).Value = "ЭМЦ"
Else
objRegExp.Pattern = "^3600"
If objRegExp.Test(Cells(i, ncolumn).Value) = True Or Cells(i, Ncolumn2).Value Like "КРП.*.3600*" And Cells(i, ncolumn4).Value Like "Бирка *" Then
Cells(i, ncolumn + 1).Value = "ПММ"
Else
If Cells(i, ncolumn).Value Like "*3000*" And Cells(i, ncolumn4).Value Like "Плата*" Or Cells(i, ncolumn).Value Like "3400*" Or Cells(i, Ncolumn2).Value Like "КРП.*.3400*" And Cells(i, ncolumn4).Value Like "Бирка *" Or Cells(i, ncolumn).Value Like "*ЭМЦ*" And Cells(i, ncolumn4).Value Like "Плата*" Then
Cells(i, ncolumn + 1).Value = "МЦ"
Else
If Cells(i, ncolumn).Value Like "*3300*" Or Cells(i, Ncolumn2).Value Like "КРП.*.3300*" And Cells(i, ncolumn4).Value Like "Бирка *" Or Cells(i, ncolumn).Value Like "*3340*" Then
Cells(i, ncolumn + 1).Value = "ПКМ"
Else
If Cells(i, ncolumn).Value Like "*3100*" Or Cells(i, Ncolumn2).Value Like "КРП.*.3100*" And Cells(i, ncolumn4).Value Like "Бирка *" Or Cells(i, ncolumn).Value Like "*CМЦ*" Or Cells(i, ncolumn).Value Like "*СМЦ*" Then
Cells(i, ncolumn + 1).Value = "СМЦ"
Else
objRegExp.Pattern = "^3800|^3801"
If objRegExp.Test(Cells(i, ncolumn).Value) = True Then
Cells(i, ncolumn + 1).Value = "ОВК"
Else
If Cells(i, ncolumn).Value Like "2400*" Then
Cells(i, ncolumn + 1).Value = "БИХ"
Else
If Cells(i, ncolumn).Value Like "2300*" Then
Cells(i, ncolumn + 1).Value = "ХТС"
Else
If Cells(i, ncolumn).Value Like "1240*" Then
Cells(i, ncolumn + 1).Value = "1240"
Else
If Cells(i, Ncolumn2).Value Like "РСТ.*" Then
Cells(i, ncolumn + 1).Value = "Уланов"
Else
If Cells(i, ncolumn).Value Like "3050*" Then
Cells(i, ncolumn + 1).Value = "ЦГО"
Else
objRegExp.Pattern = "210[0-4]"
If objRegExp.Test(Cells(i, ncolumn).Value) = True Then
Cells(i, ncolumn + 1).Value = "ОМЭ"
Else
If Cells(i, ncolumn).Value = "" Or Cells(i, ncolumn).Value = "-" Or Cells(i, ncolumn).Value = "--" Or Cells(i, ncolumn).Value = "---" Or Cells(i, ncolumn).Value = "----" Then
Cells(i, ncolumn + 1).Value = "МЦМ"
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
i = i + 1
Loop

[Iska]

1. « = True» можно убрать.
2. Вместо кучи вызовов «Cells(i, ncolumn).Value» завести строковую переменную, куда один раз запрашивать данное значение.
3. Вместо кучи вызовов «Cells(i, ncolumn + 1)» завести объектную переменную, которую и использовать далее в коде.

То есть, как-то так:
Option Explicit

Dim strValue As String
Dim objRange As Range


Do While Cells(i, Ncolumn2).Value <> Empty 'поставил на "Обозначение" т.к. обрывался на пустой ячейке
strValue = Cells(i, ncolumn).Value
Set objRange = Cells(i, ncolumn + 1)

objRegExp.Pattern = "^5085"

If objRegExp.Test(strValue) Then
objRange.Value = "С85"
Else
objRegExp.Pattern = "^5081"

If objRegExp.Test(strValue) Then
objRange.Value = "С81"
Else
If strValue Like "*3200*" Then
objRange.Value = "ЦВО"
Else
objRegExp.Pattern = "^3200-3000"

If objRegExp.Test(strValue) Or strValue Like "*3000*" Or strValue Like "*ЭМЦ*" Or Cells(i, Ncolumn2).Value Like "КРП.*.3000*" And Cells(i, ncolumn4).Value Like "Бирка *" Then
objRange.Value = "ЭМЦ"
Else
objRegExp.Pattern = "^3600"

If objRegExp.Test(strValue) Or Cells(i, Ncolumn2).Value Like "КРП.*.3600*" And Cells(i, ncolumn4).Value Like "Бирка *" Then
objRange.Value = "ПММ"
Else
If strValue Like "*3000*" And Cells(i, ncolumn4).Value Like "Плата*" Or strValue Like "3400*" Or Cells(i, Ncolumn2).Value Like "КРП.*.3400*" And Cells(i, ncolumn4).Value Like "Бирка *" Or strValue Like "*ЭМЦ*" And Cells(i, ncolumn4).Value Like "Плата*" Then
objRange.Value = "МЦ"
Else
If strValue Like "*3300*" Or Cells(i, Ncolumn2).Value Like "КРП.*.3300*" And Cells(i, ncolumn4).Value Like "Бирка *" Or strValue Like "*3340*" Then
objRange.Value = "ПКМ"
Else
If strValue Like "*3100*" Or Cells(i, Ncolumn2).Value Like "КРП.*.3100*" And Cells(i, ncolumn4).Value Like "Бирка *" Or strValue Like "*CМЦ*" Or strValue Like "*СМЦ*" Then
objRange.Value = "СМЦ"
Else
objRegExp.Pattern = "^3800|^3801"

If objRegExp.Test(strValue) Then
objRange.Value = "ОВК"
Else
If strValue Like "2400*" Then
objRange.Value = "БИХ"
Else
If strValue Like "2300*" Then
objRange.Value = "ХТС"
Else
If strValue Like "1240*" Then
objRange.Value = "1240"
Else
If Cells(i, Ncolumn2).Value Like "РСТ.*" Then
objRange.Value = "Уланов"
Else
If strValue Like "3050*" Then
objRange.Value = "ЦГО"
Else
objRegExp.Pattern = "210[0-4]"

If objRegExp.Test(strValue) Then
objRange.Value = "ОМЭ"
Else
If strValue = "" Or strValue = "-" Or strValue = "--" Or strValue = "---" Or strValue = "----" Then
objRange.Value = "МЦМ"
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If

Set objRange = Nothing

i = i + 1
Loop

По остальному — надо видеть алгоритм.

[blackeangel]

Iska, добрый день) интересует не скорость работы, а запись, что б удобно было править, визуально было понятно. С этой горкой не удобно работать.

[iglezz]

blackeangel,
Как вариант, можно завести отдельную процедуру Sub ProcessRow(i, ncolumn, ncolumn2, ...) с номерами строки и столбцов в качестве параметров.
В цикле останется
Do While Cells(i, Ncolumn2).Value <> Empty
ProcessRow i, ncolumn, ncolumn2, ...
i = i + 1
Loop
В процедуре:
Sub ProcessRow(i, ncolumn, ncolumn2, ...)
Dim strValue As String
Dim objRange As Range

strValue = Cells(i, ncolumn).Value
Set objRange = Cells(i, ncolumn + 1)

objRegExp.Pattern = "^5085"

If objRegExp.Test(strValue) Then
objRange.Value = "С85"
Exit Sub
End If

objRegExp.Pattern = "^5081"

If objRegExp.Test(strValue) Then
objRange.Value = "С81"
Exit Sub
End If

...
...
End Sub


Синтаксис примерный (на VBA уже давно ничего не писал) но вроде корректный с точки зрения документации (https://docs.microsoft.com/en-us/office/vba/api/overview/language-reference).

ЗЫ
Оптимизации в сообщении Iska - это не только оптимизация по скорости, но и минимизация ошибок из-за опечаток + более легко читаемый код (особенно если переменным присвоить более соответствующие роли имена).

[Iska]

iglezz, да, с Exit Sub — хороший вариант. Будет чуть помедленнее, зато нагляднее.

blackeangel, тут ещё такое дело… Где-то Вы пользуете регулярки посредством RegExp, где-то пользуете оператор Like… С этим действительно тяжело работать. Желательно стараться использовать какой-то единый подход.

[blackeangel]

Iska, всё сначало было на like, но не давало нужного результата, поэтому было принято решение добавить там где необходимо regexp. Конечно, можно отказаться от like и использовать regexp, но кода от этого увеличится только.

iglezz, вот да, выход из while нужно, и очевидно пропущен.

Do While Cells(i, Ncolumn2).Value <> Empty
strValue = Cells(i, ncolumn).Value
Set objRange = Cells(i, ncolumn + 1)

objRegExp.Pattern = "^5085"

If objRegExp.Test(strValue) Then
objRange.Value = "С85"
GoTo Continue
Else
......
Continue:
i=i+1
Loop

А так вы оба правы, вообще надо бросать этот while и переходить на for

[Iska]

blackeangel, а) с goto лучше вообще не связываться, б) если будет goto — никаких вложенных else уже не нужно.

[blackeangel]

Iska, не будет это да. Но почему лучше не связываться?

[greg zakharov]

Но почему лучше не связываться?
Из-за стереотипа, который сформировали в сознании труды Дейкстры, в частности об операторе goto (хотя если бы люди почаще заглядывали в дизассемблер, до них бы дошло что те же break или continue своего рода goto).
В данном случае goto не имеет смысла в виду вложенности if, которую было бы правильнее переписать в "стековую" процедуру: ни if, ни goto были бы ненужны, а скорость работы и наглядность возросли в разы.

[blackeangel]

greg zakharov, например?

[greg zakharov]

Например, выделяем паттерн проверки ячейки в отдельную процедуру, рядом создаём пул шаблонов проверки, а также шаблон стека; далее - цикл в пять-семь строк кода. И всё.

[blackeangel]

greg zakharov, :o :wacko:

[greg zakharov]

blackeangel, просто внимательней посмотрите на код: в операторе ветвления повторяются RegExp.Test и Cells(...).Value Like, значит выносим их "за скобки", то есть создаем процедуру проверки шаблона. Что здесь сложного? А далее, как было сказано ранее. В итоге у вас должно получиться нечто вроде (псевдокод):
Do While Cells(...).Value
If ParseCell(...) Then
FillCellFromStack(...)
End If
Stack.MoveNext
Loop
А вот если смайлики - намек на написание примера за вас, альтернатива такова: либо ждать иного ответа того, кто выполнит всю работу за вас на безвозмездной основе, либо озвучьте цену и получите код с детальными комментариями. На вашем месте начал бы самостоятельно реализовывать сказанное выше, чтобы было понятно впредь что да как.