excel - 如何提高 VBA 代码的性能以避免“过程太大”？

Question

我正在努力避免在我的 VBA 代码中出现“程序过大”。

我的代码必须根据描述和其他一些变量将特定类别分配给材料代码。我正在使用很多选择案例/案例，如果要这样做，最近我尝试添加集合并为集合中的每个项目使用一个，但它严重降低了我的代码的性能。

我的代码是 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

很抱歉发了这么长的帖子，等待您的反馈我该如何提高性能或者我应该使用什么来代替集合。

谢谢，

标签： excelvbafor-loop