[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

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