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