Как я могу улучшить производительность своего кода VBA, чтобы избежать «слишком большой процедуры»?

Question

Я изо всех сил стараюсь избежать "слишком большой процедуры" в моем коде VBA.

Мой код должен назначить определенную категорию коду материала на основе описания и некоторых других переменных.Я использую много вариантов выбора (Case Case / Cases), и если это делается, недавно я попытался добавить коллекции и использовать для каждого элемента в коллекции, но это сильно ухудшило производительность моего кода.

Мой кодэто 2000-3000 строк.Пожалуйста, найдите ниже часть моего кода, чтобы вы могли понять, с чем я имею дело: код коллекции:

Function CollectionMarketing()

Dim coll As New Collection
Dim collString As String

    coll.Add " data sheet"
    coll.Add " brochure"
    coll.Add " film box"
    coll.Add " data sheet"
    coll.Add " value coin"
    coll.Add " pictogra"
    coll.Add " poster"
    coll.Add " target group"
    coll.Add " flyer"
    coll.Add " blazer"
    coll.Add " pants"
    coll.Add " shirt"
    coll.Add " jacket"
    coll.Add " vest"
    coll.Add " wk overal"
    coll.Add " coat siz"
    coll.Add " dungarees"
    coll.Add " boots size"
    coll.Add " usb stick"
    coll.Add " fossil"
    coll.Add " running"
    coll.Add " blous"
    coll.Add " hoodie"
    coll.Add " shoe siz"
    coll.Add " motif"
    coll.Add " calendar"
    coll.Add " bookl"
    coll.Add " greeting"
    coll.Add " chirstmas"
    coll.Add " catalogue"
    coll.Add " illustrate"
    coll.Add " flopo"
    coll.Add " campaig"
    coll.Add " dvd "
    coll.Add " highlight"
    coll.Add " cash box"
    coll.Add " lenticul"
    coll.Add " sales"
    coll.Add " vinyl"
    coll.Add " magazine"
    coll.Add " broschüre"
    coll.Add " general term"
    coll.Add " boots"

   Set CollectionMarketing = coll

End Function

Повторяющийся код с другой строкой:

'Cellulose filter
                Case StrCheck(strng, " cartridge filte") Or StrCheck(strng, " cellulose") Or StrCheck(strng, " filter sponge")
                   If StrCheck(strng, "PES") = True Or StrCheck(strng, " PE ") = True Then ' PES Filter here
                       objSheet.Cells(iRow, 24).Value = "P00A03"
                   Else
                    objSheet.Cells(iRow, 24).Value = "P00A02"
                   End If

            'HEPA filter
             Case StrCheck(strng, " hepa") And StrCheck(strng, " filter")
                objSheet.Cells(iRow, 24).Value = "P00A08"

            'Other air filters
             Case StrCheck(strng, " pocket filte") Or StrCheck(strng, " filter cone") Or StrCheck(strng, " filter tower") Or StrCheck(strng, " demister filter ")
                objSheet.Cells(iRow, 24).Value = "P00A09"


            'Glass fibre flat fil
            Case StrCheck(strng, " flat pleated filt") Or StrCheck(strng, " flat filte")
                objSheet.Cells(iRow, 24).Value = "P00A10"

Для каждого кода цикла:

 Dim coll As Collection
 Dim collString As String
 Dim item As Variant
 Dim flg_coll As Boolean

' Set the line status to "processing..."
objSheet.Cells(iRow, 3) = 1

Set coll = CollectionMarketing
    For Each item In coll
        collString = item



 For i_count = 0 To 10

.,,повторяющийся код здесь.

Case StrCheck(strng, collString)
                     objSheet.Cells(iRow, 24).Value = "S04A00"

.

             'Shafts C02C03
      Case StrCheck(strng, " shaft") Or StrCheck(strng, " axle")
        If Left(s_actualmatgr, 3) = "M01" Then
                 objSheet.Cells(iRow, 24).Value = s_actualmatgr
        Else
        objSheet.Cells(iRow, 24).Value = "C02C03"
        End If
           End Select

     'Marketing materials
  ElseIf Left(s_material, 4) = "7.00" Then
    objSheet.Cells(iRow, 24).Value = "S01A03"


         'military equipment
  ElseIf Left(s_divisionagn, 5) = "54000" Then
        objSheet.Cells(iRow, 24).Value = "P07E00"



    End If
  End If
 s_propmatgr = objSheet.Cells(iRow, 24)

  If Left(s_propmatgr, 1) <> "" Then
    Exit For
    flg_coll = True
   End If
   Next i_count
    If flg_coll = True Then
        Exit For
        End If
     Next item

    If msg <> "" Then MsgBox msg, vbCritical


' Update the Status to "completd" and exit
objSheet.Cells(iRow, 3) = 2

Exit Function

myerr:
' Update the status to "Error"
objSheet.Cells(iRow, 3) = 3
 End Function

Извините за длинный пост, жду ваших отзывов, как я могу улучшить производительность или что я должен использовать вместо коллекций.

Спасибо,