使复杂功能更有效

时间:2015-09-28 15:12:19

标签: performance vba recordset

我有一个复杂的功能,我需要再运行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

2 个答案:

答案 0 :(得分:0)

如果我理解正确,您有一个表单可以为rstStatements SQL语句设置过滤器。这些语句与您要存储在rstCBG中的一条记录中的双行换行连接。此过程需要多次运行。

每次在表单上的某个过滤器字段中触发after_update事件时,您都可以构建concStatement。您可以将concStatement存储在表单上的隐藏字段中。然后当需要调用该函数时,您可以这样做:

DoCmd.RunSQL "UPDATE [Cross_Border_Grid_Table] SET [St_General]='" & STORED_CONCSTATEMENT & "' WHERE (Cross_Border_Grid_Table.ID)= " & [Forms]![New_Shipment_Home_frm]![Text105]

答案 1 :(得分:0)

如果一次运行所有类别,则可以使用此代码。没有桌子我无法测试它,所以也许某处有错误。

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