改进查询/ vba按链表分组 [英] Improve query/vba to group by linked list
问题描述
我收到一些表格，其中有按链表分组的元素，我很难处理它。
该函数可以找到它，但我常常被问到自从任务调度程序启动以来它的宏在哪里或有一些内存问题。
我使用下面的代码来找出idGroup（翻译成英文），我想知道是否有方法来即兴表达它，特别是它的速度，因为它需要长达一个小时的30 000行和大约2500组。 ..（这就是我使用VBA看到进展的原因......）
' 简单示例
' idGroup，id2，id1
' 6338546,14322882,13608969
' 6338546,13608969,13255 363
' 6338546,6338546,14322882
' 6338546,11837926,11316332
' 6338546,12297571,11837926
' 6338546， 13255363,12811071
' 6338546,12811071,12297571
< span class =code-comment>' 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
公共 函数 GetidGroup（）
' 首先id1始终为0
sql = SELECT idGroup，id2，id1 F ROM TABLE_WITH_LINKED_LIST WHERE id1 ='0'ORDER BY id2 DESC
Dim rs As Recordset
Dim uidLikedList As String ，id2 作为 字符串，id1 As 字符串
设置 rs = CurrentDb.OpenRecordset（sql）
Dim 总作为 长
Dim idGroup 作为 字符串
Dim incrément作为 长，进度作为 Double
total = rs.RecordCount $ b $bincrément= 1
不 rs.EOF
progress = Math.Round（ 100 *incrément/ total， 2 ）
' 打印以便冻结
Debug.Print progress
如果 rs.Fields（ idGroup）= 然后
id2 = rs。字段（ id2）
idGroup = precedentUid（id2）
rs.Edit
rs.Fields（ idGroup）= idGroup
rs 。更新
结束 如果
$ b $bincrément=incrément+ 1
rs.MoveNext
Wend
rs.Close
设置 rs = 没什么
GetidGroup =总计
结束 功能
' 递归函数
' 目前最深的是62次调用
公共 功能 precedentUid（id2 作为 String ） as String
sql = SELECT idGroup，id2 FROM TABLE_WITH_LINKED_LIST WHERE id1 ='& id2& '
Dim rs As Recordset
Dim precedentid2 As 字符串
Dim idGroup As 字符串
Dim ret As 字符串
设置 rs = CurrentDb.OpenRecordset（sql）
如果 rs.EOF 那么
rs.Close
设置 rs = Nothing
precedentUid = id2
Else
' 某些记录有多个引用
' 56个受影响的记录：
' TODO：将min id2提供给组
ret = - 1
不 rs.EOF
如果 rs.Fields（ idGroup）= 然后
precedentid2 = rs.Fields（ id2）
idGroup = precedentUid（precedentid2）
如果 re t = - 1 或 < span class =code-keyword> CLng （ret）> CLng （idGroup）然后
ret = idGroup
结束 如果
' Debug.Print id2& &先行者2& & idGroup
rs.Edit
rs.Fields（ idGroup ）= idGroup
rs.Update
结束 如果
rs.MoveNext
Wend
rs.Close
Set rs = 没什么
precedentUid = ret
结束 如果
结束 功能
提前感谢任何提示。
Guillaume。
如果我理解你，你试图将idGroup更新为MIN（id2）如果idGroup =并且id1 =0。
如果以上是真的，你不需要任何VBA代码，你只需 UPDATE [ ^ ]查询基于同一张表。
它可能是这样的：
更新 LINKED_LISTS AS LL
INNER JOIN （
SELECT MIN（id2） AS idGroup
FROM LINKED_LISTS
WHERE idGroup = AND id1 = 0） AS T1 ON LL.id2 = T1.id2
SET idGroup = T1.idGroup
例如：
http://www.fmsinc.com/microsoftaccess/query/snytax/update-query.html [ ^ ]
http://msdn.microsoft.com/en-us/library/office/bb221186%28v=office.12%29.aspx [< a href =http://msdn.microsoft.com/en-us/library/office/bb221186%28v=office.12%29.aspxtarget =_ blanktitle =New Window> ^ ]
http://www.techonthenet.com/access/queries/update2。 php [ ^ ]
http://stackoverflow.com/questions/871905/use-select-inside-an-update-query [< a href =http://stackoverflow.com/questions/871905/use-select-inside-an-update-querytarget =_ blanktitle =新窗口> ^ ]
顺便说一句：我想知道为什么id'的字段是文本字段？
我自己并没有解决这个问题，但是我已经获得了更好的回复范德加斯特的MSDN [ ^ ]
Hi,
I receive some tables where there are elements grouped by linked lists and I have trouble to deal with it.
The function works find as it but I''m often asked where is its macro when launched since task scheduler or have some memory issues.
I use the following code to find out the idGroup (translated to English) and I''m wondering if there would by ways to improvise it especially its speed because it takes up to an hour for 30 000 rows and about 2500 groups... (It''s why I had used VBA to see progress...)
'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
Thanks in advance for any hint.
Guillaume.
If i understand you well, you''re trying to updateidGrouptoMIN(id2)ifidGroup="" And id1="0".
If above is true, you don''t need any VBA code, you need only UPDATE[^] query based on the same table.
It could be something like this:
UPDATE LINKED_LISTS AS LL INNER JOIN ( SELECT MIN(id2) AS idGroup FROM LINKED_LISTS WHERE idGroup="" AND id1="0") AS T1 ON LL.id2 = T1.id2 SET idGroup = T1.idGroup
Examples:
http://www.fmsinc.com/microsoftaccess/query/snytax/update-query.html[^]
http://msdn.microsoft.com/en-us/library/office/bb221186%28v=office.12%29.aspx[^]
http://www.techonthenet.com/access/queries/update2.php[^]
http://stackoverflow.com/questions/871905/use-select-inside-an-update-query[^]
BTW: I''m wondering why id''s fields are text fields?
I didn''t solve this myself but I had been given the better reply on MSDN by Vanderghast[^]
这篇关于改进查询/ vba按链表分组的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
