[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 уже давно ничего не писал) но вроде корректный с точки зрения документации.

ЗЫ
Оптимизации в сообщении 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, например?