performance - 让复杂的功能更高效

Question

我有一个复杂的函数，我需要再运行 19 次，每次运行时唯一改变的参数是第一个参数“语句类型”(语句类型包括一般信息、培训、代理标签等) .该函数将参数列表与文本“语句”表进行比较，并将匹配的任何语句返回到旨在保存该类型语句的备注单元格中。这种设计确实是必要的，但我担心运行所有 20 个所需的时间。我能做些什么来使它尽可能高效并减少运行时间吗？先感谢您!

Function StatementUpdate()

Dim dbs As DAO.Database
Dim rstStatements As DAO.Recordset
Dim rstCBG As DAO.Recordset
Dim concStatement As String
Dim strSQL As Variant

Set dbs = CurrentDb()

'Working SQL except defaulting to ALL and not sensing partial string match, with added parenth shipment type was working
strSQL = "SELECT [Statement] FROM [St_Gen_Qry] WHERE" _
         & " (([Statement Category]='General Information')" _
         & " And (([Export Country] Like ('*" & Forms!New_Shipment_Home_frm.[Export Country] & "*'))" _
         & " Or ([Export Country]='All'))" _
         & " And (([Export State] Like ('*" & Forms!New_Shipment_Home_frm.[Export State] & "*'))" _
         & " Or ([Export State]='All'))" _
         & " And (([Import Country] Like ('*" & Forms!New_Shipment_Home_frm.[Import Country] & "*'))" _
         & " Or ([Import Country]='All'))" _
         & " And (([Import State] Like ('*" & Forms!New_Shipment_Home_frm.[Import State] & "*'))" _
         & " Or ([Import State]='All'))" _
         & " And (([Material Category] Like ('*" & Forms!New_Shipment_Home_frm.[Material Category] & "*'))" _
         & " Or ([Material Category]='All'))" _
         & " And (([Sub Category] Like ('*" & Forms!New_Shipment_Home_frm.[Sub Category] & "*'))" _
         & " Or ([Sub Category]='All'))" _
         & " And (([Transgenic/ Conventional] Like ('*" & Forms!New_Shipment_Home_frm.RegCode & "*'))" _
         & " Or ([Transgenic/ Conventional] ='All'))" _
         & " And (([Intended Use] Like ('*" & Forms!New_Shipment_Home_frm.[Intended Use] & "*'))" _
         & " Or ([Intended Use]='All'))" _
         & " And (([Permit] Like ('*" & Forms!New_Shipment_Home_frm.[Permit Required] & "*'))" _
         & " Or ([Permit]='All')) " _
         & " And (([Shipment Type] Like ('*" & Forms!New_Shipment_Home_frm.[Shipment Type] & "*'))" _
         & " Or ([Shipment Type]='All'))" _
         & " And ([Active]='Yes'))"

Debug.Print strSQL
Set rstStatements = dbs.OpenRecordset(strSQL, dbOpenDynaset)
Set rstCBG = dbs.OpenRecordset("SELECT Cross_Border_Grid_Table.ID,      Cross_Border_Grid_Table.St_General FROM Cross_Border_Grid_Table WHERE   (Cross_Border_Grid_Table.ID)= " & [Forms]![New_Shipment_Home_frm]![Text105])


rstCBG.MoveFirst

'loop through each record in the CBG that matches select query
Do Until rstCBG.EOF
    concStatement = ""
    rstStatements.MoveFirst
    Do Until rstStatements.EOF
        concStatement = concStatement & vbCrLf & rstStatements(0) & vbCrLf
        rstStatements.MoveNext
    Loop
        rstCBG.Edit
        rstCBG![St_General] = concStatement
        rstCBG.Update
        rstCBG.MoveNext
        Loop

rstCBG.Close
rstStatements.Close

Set rstStatements = Nothing
Set rstCBG = Nothing
Set dbs = Nothing


Debug.Print "Done"

End Function

Answer 1

如果同时运行所有类别，您可以使用此代码。没有表格我无法测试它，所以可能某处有错误。

Function StatementUpdate()

    Dim dbs As DAO.Database
    Dim rstStatements As DAO.Recordset
    Dim rstCBG As DAO.Recordset
    Dim strSQL As Variant

    Dim sSt_General As String
    Dim sSt_Expiration As String       
    Dim sSt_Training As String 
    Dim sSt_Packing As String 

    'Working SQL except defaulting to ALL and not sensing partial string match, with added parenth shipment type was working
    strSQL = "SELECT [Statement],[Statement Category] FROM [St_Gen_Qry] WHERE" _
             & " ((([Export Country] Like ('*" & Forms!New_Shipment_Home_frm.[Export Country] & "*'))" _
             & " Or ([Export Country]='All'))" _
             & " And (([Export State] Like ('*" & Forms!New_Shipment_Home_frm.[Export State] & "*'))" _
             & " Or ([Export State]='All'))" _
             & " And (([Import Country] Like ('*" & Forms!New_Shipment_Home_frm.[Import Country] & "*'))" _
             & " Or ([Import Country]='All'))" _
             & " And (([Import State] Like ('*" & Forms!New_Shipment_Home_frm.[Import State] & "*'))" _
             & " Or ([Import State]='All'))" _
             & " And (([Material Category] Like ('*" & Forms!New_Shipment_Home_frm.[Material Category] & "*'))" _
             & " Or ([Material Category]='All'))" _
             & " And (([Sub Category] Like ('*" & Forms!New_Shipment_Home_frm.[Sub Category] & "*'))" _
             & " Or ([Sub Category]='All'))" _
             & " And (([Transgenic/ Conventional] Like ('*" & Forms!New_Shipment_Home_frm.RegCode & "*'))" _
             & " Or ([Transgenic/ Conventional] ='All'))" _
             & " And (([Intended Use] Like ('*" & Forms!New_Shipment_Home_frm.[Intended Use] & "*'))" _
             & " Or ([Intended Use]='All'))" _
             & " And (([Permit] Like ('*" & Forms!New_Shipment_Home_frm.[Permit Required] & "*'))" _
             & " Or ([Permit]='All')) " _
             & " And (([Shipment Type] Like ('*" & Forms!New_Shipment_Home_frm.[Shipment Type] & "*'))" _
             & " Or ([Shipment Type]='All'))" _
             & " And ([Active]='Yes'))"

   Debug.Print strSQL
   Set rstStatements = dbs.OpenRecordset(strSQL)
   Set rstCBG = dbs.OpenRecordset("SELECT ID, St_General, St_Expiration, St_Training, St_Packing FROM Cross_Border_Grid_Table WHERE ID= " & [Forms]![New_Shipment_Home_frm]![Text105])

   With rstStatements
        Do Until rstStatements.EOF
            Select Case rstStatements![Statement Category]
                Case "General Information"
                    sSt_General = sSt_General & vbCrLf & rstStatements![Statement] & vbCrLf
                Case "Expiration"
                    sSt_Expiration = sSt_Expiration & vbCrLf & rstStatements![Statement] & vbCrLf
                Case "Training"
                    sSt_Training = sSt_Training & vbCrLf & rstStatements![Statement] & vbCrLf
                Case "Packing"
                    sSt_Packing = sSt_Packing & vbCrLf & rstStatements![Statement] & vbCrLf
            End Select
            .MoveNext
        Loop
        .Close
    End With

With rstCBG
    .MoveFirst
    .Edit
    rstCBG![St_General] = sSt_General
    rstCBG![St_Expiration] = sSt_Expiration
    rstCBG![St_Training] = sSt_Training
    rstCBG![St_Packing] = sSt_Packing
    .Update
    .Close
End With

Set rstStatements = Nothing
Set rstCBG = Nothing

Debug.Print "Done"

End Function