0

每次用户进入新记录时，我的表单都会挂起几秒钟。表单上列表框的记录集是一个查询。表单一直挂起，直到该查询完成并填充列表框。

我的用户需要能够快速滚动浏览记录。目前，用户必须等待列表框查询完成才能移动到下一条记录。如何阻止表格挂起？

有没有办法使用 DoEvents 来解决这个问题？

下面是我的代码。我怀疑没有必要查看所有这些代码，但我将其全部共享以防万一。

我正在使用访问。

谢谢！

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
4

2 回答 2

0

我认为您可能有错误的表单事件。form_Current 事件在每条记录之间触发，我无法想象这是您真正需要的。尝试将您的“匹配”例程移动到 OnLoad 事件中。

于 2014-01-17T21:49:27.977 回答
0

UI 挂起，因为工作正在由 UI 线程完成。如果您想要（或需要）响应速度更快的应用程序，则需要将工作卸载到后台线程。据我所知，对于 VBA，这不是虚张声势的东西，但你可以看看，VBA + Threads in MS Access。

由于 access 是一个数据库，因此它具有任何数据库的所有缺点，主要是查找存储在慢速（通常是旋转）介质上的数据。我建议你看看这篇文章：创建和使用索引来提高性能，以帮助你为查询创建有效的索引，如果你还没有为它们建立索引的话。您还需要考虑 、 和 的WHERE性能JOIN影响ORDER BY查询中的子句。确保您的索引针对您的查询进行了优化，并且您的数据以符合查询方式的逻辑方式存储。除此之外，如果数据库不驻留在执行查询的机器上，则除了预期的磁盘 I/O 延迟之外，还有网络 I/O 延迟。这会显着影响数据库的读取性能。

于 2014-01-16T17:27:57.753 回答