我收到一些表格,其中有按链接列表分组的元素,但我无法处理它。
该函数可以正常工作,但我经常被问到自任务调度程序启动时它的宏在哪里,或者有一些内存问题。
我使用以下代码找出 idGroup(翻译成英文),我想知道是否有办法改进它,尤其是它的速度,因为 30 000 行和大约 2500 个组最多需要一个小时......(这就是为什么我使用 VBA 来查看进度......)
'Simple example
'idGroup,id2,id1
'6338546,14322882,13608969
'6338546,13608969,13255363
'6338546,6338546,14322882
'6338546,11837926,11316332
'6338546,12297571,11837926
'6338546,13255363,12811071
'6338546,12811071,12297571
'6338546,7610194,7343817
'6338546,7935943,7610194
'6338546,8531387,7935943
'6338546,6944491,6611041
'6338546,7343817,6944491
'6338546,9968746,9632204
'6338546,10381694,9968746
'6338546,6611041,0
'6338546,8920224,8531387
'6338546,9632204,8920224
'6338546,11316332,10941093
'6338546,10941093,10381694
Public Function GetidGroup()
'first id1 is always 0
sql = "SELECT idGroup, id2, id1 FROM TABLE_WITH_LINKED_LIST WHERE id1='0' ORDER BY id2 DESC"
Dim rs As Recordset
Dim uidLikedList As String, id2 As String, id1 As String
Set rs = CurrentDb.OpenRecordset(sql)
Dim total As Long
Dim idGroup As String
Dim incrément As Long, progress As Double
total = rs.RecordCount
incrément = 1
While Not rs.EOF
progress = Math.Round(100 * incrément / total, 2)
'Print in order to avoir freezing
Debug.Print progress
If rs.Fields("idGroup") = "" Then
id2 = rs.Fields("id2")
idGroup = precedentUid(id2)
rs.Edit
rs.Fields("idGroup") = idGroup
rs.Update
End If
incrément = incrément + 1
rs.MoveNext
Wend
rs.Close
Set rs = Nothing
GetidGroup = total
End Function
'Recursive function
'Deepest so far is about 62 calls
Public Function precedentUid(id2 As String) As String
sql = "SELECT idGroup, id2 FROM TABLE_WITH_LINKED_LIST WHERE id1 = '" & id2 & "'"
Dim rs As Recordset
Dim precedentid2 As String
Dim idGroup As String
Dim ret As String
Set rs = CurrentDb.OpenRecordset(sql)
If rs.EOF Then
rs.Close
Set rs = Nothing
precedentUid = id2
Else
'Some records have several references
'56 impacted records :
'TODO : Give the min id2 to the group
ret = "-1"
While Not rs.EOF
If rs.Fields("idGroup") = "" Then
precedentid2 = rs.Fields("id2")
idGroup = precedentUid(precedentid2)
If ret = "-1" Or CLng(ret) > CLng(idGroup) Then
ret = idGroup
End If
'Debug.Print id2 & " " & precedentid2 & " " & idGroup
rs.Edit
rs.Fields("idGroup") = idGroup
rs.Update
End If
rs.MoveNext
Wend
rs.Close
Set rs = Nothing
precedentUid = ret
End If
End Function
最佳答案
一些建议:
precedentUid
时)。相反,请考虑使用按 idGroup
+ id1
排序的单个记录集并向上或向下查找适当的值。 idGroup
+ id1
,我建议将其设为主键。然后,您将能够使用 Seek
方法进行更快的搜索。 idGroup
时,请将 SQL 语句与 CurrentDb.Execute
一起使用。 idGroup
中缓存搜索 Dictionary
的结果(引用 Microsoft Scripting Runtime 在 工具 -> References )。这样,您就不会在递归时重复搜索。 Long
,而不是 Text
。如果您对此没有控制权,我会考虑创建一个具有适当数据类型的临时表。 关于sql - Access 2007 改进查询/vba 以按链接列表分组,我们在Stack Overflow上找到一个类似的问题:https://stackoverflow.com/questions/12728248/