每次用户转到新记录时,我的表单都会挂起几秒钟。表单上的列表框的记录集是查询。表单将一直挂起,直到该查询完成并填充列表框。
我的用户需要能够快速滚动记录。目前,用户必须等待列表框查询完成才能移动到下一条记录。如何阻止表格挂起?
有没有办法让DoEvents用来解决这个问题?
以下是我的代码。我怀疑看到所有这些代码并不是必需的,但为了以防万一我分享它。
我正在使用Access。
谢谢!
Option Compare Database 'Use database order for string comparisons
Option Explicit
Dim QuoteLogForm As Form
Public KeystrokeCount As Integer
'Define the similarity threshold for the matches list
Const SIMIL_THRESHOLD As Single = 0.83
Private m_strDialogResult As String
'The basis of this code was derived from http://www.accessmvp.com/tomvanstiphout/simil.htm
Private Sub Form_Current()
Matches
End Sub
Private Sub Matches()
'This sub calls the functions necessary to generate a query that lists
'the KFC RFQ #'s whose similarity exceeds the threashold, as defined above.
Dim sql As String
Dim strOpenArgs As String
Dim strInClause As String
'OpenArgs contains the part # to find similars for.
strOpenArgs = Replace(Replace(Nz(Me.Part_Number_Textbox.Value), "-", ""), " ", "") 'Nz changes Nulls to blanks
'Call the GetSimilarPartNos function below.
'This function returns a string of KFC RFQ #'s that exceed the threashold, wrapped in single quotes and separated by commas.
strInClause = GetSimilarPartNos(strOpenArgs)
'If any similar part numbers were found, run a query to select all the listed records
If VBA.Len(strInClause) > 0 Then
'Select records whose KFC RFQ #'s are found in the strInClause list, sort from most to least similar
sql = "select * from [Matches List Query] where [KFC RFQ #] in (" & strInClause & ")" ' order by SimilPct desc, DateShort desc"
'[Forms]![Price Form Parent]![Price Form].[Form].Customer_Filter_Box
Set Me.[Matches List Form].Form.Recordset = CurrentDb.OpenRecordset(sql, dbOpenSnapshot)
Else
'If no similar KFC RFQ #'s were found, select no records
sql = "select * from [Matches List Query] where 1 = 0"
Set Me.[Matches List Form].Form.Recordset = CurrentDb.OpenRecordset(sql, dbOpenSnapshot)
End If
End Sub
Private Function GetSimilarPartNos(ByVal strPartNo As String) As String
'The GetSimilarPartNos function calls the fnSimil function and compiles a list (strInClause)
'of KFC RFQ #'s whose part numbers exceed the threashold
Dim rs As DAO.Recordset
Dim strInClause As String
Dim sngSimil As Single
'Erase all previous values in the [Quote Log].Simil field
CurrentDb.Execute "update [Quote Log] set Simil = 0", dbFailOnError
Set rs = CurrentDb.OpenRecordset("Quote Log") ', dbOpenTable)
'Loop to calculate the similarity of all part numbers
While Not rs.EOF 'Loop until the end
Dim curPartNo As String
curPartNo = Replace(Replace(Nz(rs![Part #]), "-", ""), " ", "")
If rs![KFC RFQ #] = Me.[KFC RFQ #] Then
GoTo 120
End If
sngSimil = fnSimil(curPartNo, strPartNo)
'If the part number similarity value of a single record is greater than the
'threashold (as defined above), add the record's KFC RFQ # to strInClause
'strInClause forms a list of KFC RFQ #'s whose part numbers exceed the threashold
'in similarity, wrapped in single quotes and separated by commas
If sngSimil >= SIMIL_THRESHOLD Then
strInClause = strInClause & "'" & rs![KFC RFQ #] & "',"
'Show the Simil value on this form
rs.Edit
rs!Simil = sngSimil
rs.Update
End If
120 rs.MoveNext
Wend
rs.Close
Set rs = Nothing
'Once the strInClause is completed, remove the last comma from the list
If Len(strInClause) > 0 Then strInClause = VBA.Left$(strInClause, Len(strInClause) - 1)
GetSimilarPartNos = strInClause
End Function
答案 0 :(得分:0)
UI正在悬空,因为工作正在由UI线程完成。如果您想要(或需要)响应更快的应用程序,则需要将工作卸载到后台线程。据我所知,对于VBA而言,这不是佯装的事,但你可以看看,VBA + Threads in MS Access。
由于访问是一个数据库,它会遇到任何数据库的所有缺点,主要是查找存储在慢速,通常是旋转的媒体上的数据。我建议你看一下这篇文章:Create and use an index to improve performance,以帮助你为你的查询创建有效的索引,如果你还没有索引它们。您还需要考虑查询中WHERE
,JOIN
和ORDER BY
子句的性能影响。确保您的索引针对您的查询进行了优化,并且您的数据以逻辑方式存储,以便查询出来。除此之外,如果数据库不驻留在执行查询的计算机上,则在预期的磁盘I / O延迟之上会出现网络I / O延迟。这可能会显着影响数据库的读取性能。
答案 1 :(得分:0)
我认为你可能有错误的表格事件。 form_Current事件在每条记录之间触发,我无法想象这就是你真正需要的东西。尝试将“匹配”例程移动到OnLoad事件中。