让复杂的功能更高效
Make complex function more efficient
我有一个复杂的函数，我需要再 运行 19 次，每次 运行 唯一改变的参数是第一个参数 "statement type" （语句类型包括一般信息、培训、机构标签等）。该函数将参数列表与 table 文本 "statements" 和 returns 任何匹配到旨在保存该类型语句的备注单元格中的语句进行比较。这种设计确实很有必要，但我担心 运行 全部 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
如果我没理解错的话，您有一个为 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]
如果所有类别同时为 运行，您可以使用此代码。没有表格我无法测试它，所以可能某处有错误。
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
我有一个复杂的函数，我需要再 运行 19 次，每次 运行 唯一改变的参数是第一个参数 "statement type" （语句类型包括一般信息、培训、机构标签等）。该函数将参数列表与 table 文本 "statements" 和 returns 任何匹配到旨在保存该类型语句的备注单元格中的语句进行比较。这种设计确实很有必要，但我担心 运行 全部 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
如果我没理解错的话，您有一个为 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]
如果所有类别同时为 运行，您可以使用此代码。没有表格我无法测试它，所以可能某处有错误。
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