MS Access VBA优化订单CustomerID补全算法（降低N²复杂度）

问题背景 #

我有个5000条记录的Orders表和5000条记录的Customers表，Orders里部分CustomerID是空的，得补全。当前算法是遍历所有空ID的订单，拿name、country、cluster三个字段去遍历整个Customers表找匹配：找到就填ID，没找到就新建客户再填。但这算法最坏情况是O(N²)，跑起来巨慢。

原代码如下：

Public Sub TransferNullValues() 'hard coded parameters are "Orders", "Customers"
    Set coll = New Collection
    coll.Add "CustomerID"
    coll.Add "End_customer"
    coll.Add "End_customer_country"
    coll.Add "Cluster"
    
    Dim sqlStr As String
    sqlStr = "SELECT " & buildSql(coll) & " FROM Orders where Orders.CustomerID is null;"
    coll.Remove (1) 'remove customer id
    
    Dim rss As DAO.Recordset
    Set rss = Basic.getRs(sqlStr)
    
    Do While Not rss.EOF
        Dim locals As Collection
        Set locals = New Collection
        
        Dim v As Variant
        For Each v In coll
            locals.Add (rss(v).value)
        Next
        
        Dim id As Integer
        id = getCustID(locals)
        
        rss.Edit
        rss("CustomerID").value = id
        rss.Update
            
        rss.MoveNext
    Loop
    
    rss.Close
    Set rss = Nothing
    
End Sub

Private Function getCustID(locals As Collection) As Integer
    Dim sqlStr As String
    sqlStr = "SELECT * FROM CUSTOMERS;"
    Dim rst As DAO.Recordset
    Set rst = Basic.getRs(sqlStr)
    Dim trgt As Collection
    
    
    Do While Not rst.EOF
        Set trgt = New Collection
        
        Dim v As Variant
        For Each v In coll
            trgt.Add (rst(v).value)
        Next
        
        Dim allExists As Boolean
        allExists = True
        
        For Each v In locals
            If Not Basic.Exists(trgt, v) Then
                allExists = False
                Exit For
            End If
        Next
        
        If allExists Then
            getCustID = rst("CustomerID").value
            'Debug.Print "customer exists in customers table"
            Exit Function
        End If
    
        rst.MoveNext
        
    Loop
    
    rst.AddNew
    Dim count As Integer
    count = 1
    For Each v In locals
        rst.Fields(count).value = v
        count = count + 1
    Next
    
    Dim id As Integer
    id = rst("CustomerID")
    
    rst.Update
        rst.Close
    Set rst = Nothing
    
    getCustID = id
End Function

优化方案 #

核心是用数据库的查询能力替代循环遍历，把O(N²)复杂度降到O(N)：

1. 给Customers表的End_customer、End_customer_country、Cluster建联合索引，让匹配查询瞬间完成
2. 直接用SQL语句查匹配的客户ID，不用遍历整个客户表
3. 减少循环里的数据库操作次数，降低IO开销

修改后的代码 #

Public Sub TransferNullValues()
    ' 定义用于匹配的字段
    Dim matchFields As String
    matchFields = "End_customer, End_customer_country, Cluster"
    Dim orderQueryFields As String
    orderQueryFields = "CustomerID, " & matchFields
    
    ' 取出所有需要补全CustomerID的订单记录
    Dim sqlGetOrders As String
    sqlGetOrders = "SELECT " & orderQueryFields & " FROM Orders WHERE CustomerID IS NULL;"
    
    Dim rsOrders As DAO.Recordset
    Set rsOrders = Basic.getRs(sqlGetOrders)
    
    Do While Not rsOrders.EOF
        ' 提取当前订单的匹配字段值，用Nz处理空值避免出错
        Dim custName As String, custCountry As String, custCluster As String
        custName = Nz(rsOrders("End_customer"), "")
        custCountry = Nz(rsOrders("End_customer_country"), "")
        custCluster = Nz(rsOrders("Cluster"), "")
        
        ' 构造SQL查询匹配的客户ID，替换单引号防止语法错误
        Dim sqlFindCust As String
        sqlFindCust = "SELECT CustomerID FROM Customers WHERE " & _
                      "End_customer = '" & Replace(custName, "'", "''") & "' AND " & _
                      "End_customer_country = '" & Replace(custCountry, "'", "''") & "' AND " & _
                      "Cluster = '" & Replace(custCluster, "'", "''") & ";"
        
        Dim rsCust As DAO.Recordset
        Set rsCust = Basic.getRs(sqlFindCust)
        
        Dim targetCustId As Integer
        If rsCust.RecordCount > 0 Then
            ' 找到匹配的客户，直接取ID
            targetCustId = rsCust("CustomerID").Value
        Else
            ' 没找到就新建客户记录
            rsCust.Close
            Set rsCust = Basic.getRs("SELECT * FROM Customers WHERE 1=0;") ' 获取空记录集用于新增
            rsCust.AddNew
            rsCust("End_customer").Value = custName
            rsCust("End_customer_country").Value = custCountry
            rsCust("Cluster").Value = custCluster
            rsCust.Update
            ' 获取刚新增的客户ID
            rsCust.Bookmark = rsCust.LastModified
            targetCustId = rsCust("CustomerID").Value
        End If
        
        ' 更新当前订单的CustomerID
        rsOrders.Edit
        rsOrders("CustomerID").Value = targetCustId
        rsOrders.Update
        
        ' 清理资源
        rsCust.Close
        Set rsCust = Nothing
        rsOrders.MoveNext
    Loop
    
    ' 收尾清理
    rsOrders.Close
    Set rsOrders = Nothing
End Sub

额外提速建议 #

• 建联合索引：在Customers表执行这条SQL创建索引，匹配查询速度会再上一个台阶：

  CREATE INDEX idx_Customer_Match ON Customers (End_customer, End_customer_country, Cluster);
  

• 批量处理：如果空订单数量多，可以先把所有待匹配的字段组合查出来，一次性插入所有不存在的客户，再批量更新订单的CustomerID，能大幅减少和数据库的交互次数
• 空值处理：用Nz函数处理字段空值，避免空字符串导致的匹配错误

内容的提问来源于stack exchange，提问作者Martin