Access 2007 改进查询/vba 以按链表分组答案

【问题标题】：Access 2007 Improve query/vba to group by linked listAccess 2007 改进查询/vba 以按链表分组
【发布时间】：2012-09-25 13:07:53
【问题描述】：

我收到一些表格，其中有一些按链表分组的元素，但我无法处理它。

该功能可以正常工作，但我经常被问到自任务调度程序启动后它的宏在哪里或有一些内存问题。

我使用以下代码找出 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

【问题讨论】：

标签： sql vba ms-access office-2007

【解决方案1】：

一些建议：

您正在打开大量记录集（每次调用precedentUid）。相反，请考虑使用按idGroup+id1 排序的单个记录集，并向上或向下寻找适当的值。
由于您总是在idGroup+id1 上搜索，我建议将其设为主键。然后，您将能够使用Seek 方法进行更快的搜索。
一旦有了主键，就无需编辑单个记录集，而且加载速度会更快。当您必须更新idGroup 时，请将SQL 语句与CurrentDb.Execute 一起使用。
在Dictionary 中缓存idGroup 的搜索结果（参考工具中的Microsoft Scripting Runtime -> 参考） .这样，您就不会在递归时重复搜索。
您的示例数据似乎都是数字，但您正在从记录集中检索它们作为字符串。基础数据类型应该是Long，而不是Text。如果您对此无法控制，我会考虑使用适当的数据类型创建一个临时表。

【讨论】：