需要帮助优化vba显示function

我已经做了一些数据库工作与Excel中作为数据库和数据库驱动程序通过与VBA的macros。 我构build了一个函数,该函数应该通过带有testID字段的数据库logging列表进行parsing。 我想基于它的testID来显示每个testing一次,但数据库的设置方式意味着我必须消除重复的testID。 我通过遍历logging集并在列表中显示之前检查当前testing与前一个testing。 我遇到的问题是这个function太慢了。 对于数据库中只有12个testing,大约需要3秒钟将其显示在视图电子表格中。 我很想听听关于如何优化运行时间的一些想法。 这个function:

Public Function showAllTests() Dim conn As ADODB.Connection Dim rs As ADODB.Recordset Dim cstring, sql As String Dim r, c As Integer Dim testsAr As Variant Dim inAr As Boolean cstring = "Provider = Microsoft.ACE.OLEDB.12.0; Data Source=I:\DBtrials.xlsx; Extended Properties=""Excel 12.0 Xml; HDR=YES;ReadOnly=False"";" sql = "SELECT [TestID], [Status], [PFIBox], [WireType], [StartingDia], [Customer], [numSamples], [Assigned] FROM [Tests$]" Set conn = New ADODB.Connection Set rs = New ADODB.Recordset Call conn.Open(cstring) Set rs = conn.Execute(sql) If rs.EOF Then Range("C6:J1000").ClearContents End If r = 6 count = 0 'Iterates through the recordset, eliminating duplicates and populating cells in the tests sheet While Not rs.BOF And Not rs.EOF Dim prevID, currID As String Dim currCell As Range inAr = False If Not count = 0 Then prevID = ActiveWorkbook.Sheets("Tests").Cells(r - 1, 3).Value currID = CStr(rs(0)) If prevID = currID Then inAr = True End If End If For c = 3 To (rs.Fields.count + 2) Set currCell = ActiveWorkbook.Sheets("Tests").Cells(r, c) If Not IsNull(rs(c - 3).Value) And inAr = False Then currCell.Value = CStr(rs(c - 3)) ElseIf IsNull(rs(c - 3).Value) Then currCell.Value = "" Else: Exit For End If Next c If inAr = False Then r = r + 1 End If rs.MoveNext count = count + 1 Wend conn.Close Set conn = Nothing 

结束function

使用GROUP BY

sql =“SELECT [TestID],[Status],[PFIBox],[WireType],[StartingDia],[Customer],[numSamples],[Assigned] FROM [Tests $] GROUP BY [TestID]

还有一些这样的驱动程序–Microsoft.ACE.OLEDB.12.0等在VBA中具有可怕的性能。 有时我从OBDC 6.2中获得比ADO更好的性能