Access 2007通過鏈接列表改善查詢/ vba到組

我收到一些表格，其中有鏈接列表分組的元素，我無法處理它。Access 2007通過鏈接列表改善查詢/ vba到組

這個函數可以找到它，但是我經常被問到自從任務調度程序啓動後它的宏在哪裏，或者有一些內存問題。

我使用下面的代碼來找出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

來源

2012-10-04 Guillaume666

幾點建議：

您正在打開大量記錄集（每次調用precedentUid）。相反，請考慮使用按idGroup + id1排序的單個記錄集並尋找合適的值。
既然你總是搜索idGroup + id1，我會建議這應該成爲一個主要關鍵。然後，您將可以使用Seek方法進行更快速的搜索。
一旦你有一個主鍵，就不需要單個記錄集可以編輯，並且它會加載得更快。當您必須更新idGroup時，請使用SQL語句和CurrentDb.Execute。
緩存（在工具參考Microsoft腳本運行時 - >參考）在Dictionary搜索的idGroup的結果。這樣，你不會在遞歸時重複搜索。
您的示例數據似乎是所有數字，但您是從記錄集中檢索它們作爲字符串。基礎數據類型應該是Long，而不是Text。如果你不能控制這個，我會考慮用適當的數據類型創建一個臨時表。

來源

2012-10-28 15:53:10

Access 2007通過鏈接列表改善查詢/ vba到組

回答

相關問題