代码效率太低，请求帮助优化。时间与流水号匹配查找名单

业务员

第一张表的时间与编号两个字段，去第二张表匹配相应字段，如果匹配，那么把相匹配的第一个名字引用过来。
如果无法精确匹配，那么放宽时间条件，如果表一中的时间比表二中的晚一天，也引用相符合的第一个名字过来。
如果还找不到，就返回#NA


Sub 宏2()
Dim arr, xD, T$, i&


Set xD = CreateObject("scripting.dictionary")
arr = Sheet2.[a1].CurrentRegion
For i = 2 To UBound(arr)
    T = arr(i, 1) & "|" & arr(i, 2)
    xD(T) = arr(i, 3)
Next i
arr = Sheet1.[a1].CurrentRegion

For i = 2 To UBound(arr)
    T = xD(arr(i, 1) & "|" & arr(i, 3))
    If T <> "" Then
    arr(i - 1, 1) = T
    Else
        If xD.exsits((arr(i, 1) - 1) & "|" & arr(i, 3)) Then
        arr(i - 1, 1) = xD((arr(i, 1) - 1) & "|" & arr(i, 3))
        Else
        arr(i - 1, 1) = "#NA"
        End If
    End If
   
Next i
Sheet1.[e2].Resize(UBound(arr) - 1, 1) = arr



End Sub

全党

1. Sub 宏2()
   
2. Dim arr, d As Object, T$, i&
   
3. Set d = CreateObject("scripting.dictionary")
   
4. arr = Sheet2.[a1].CurrentRegion
   
5. For i = 2 To UBound(arr)
   
6.     T = arr(i, 1) & "|" & arr(i, 2)
   
7.     d(T) = arr(i, 3)
   
8. Next i
   
9. arr = Sheet1.[a1].CurrentRegion
   
10. For i = 2 To UBound(arr)
    
11.         If d.Exists((arr(i, 1)) & "|" & arr(i, 3)) Then
    
12.            arr(i, 5) = d((arr(i, 1)) & "|" & arr(i, 3))
    
13.         ElseIf d.Exists((arr(i, 1) - 1) & "|" & arr(i, 3)) Then
    
14.            arr(i, 5) = d((arr(i, 1) - 1) & "|" & arr(i, 3)) & "（上日数据）"
    
15.         Else
    
16.            arr(i, 5) = "#NA"
    
17.         End If
    
18. Next i
    
19. [a1].Resize(UBound(arr), UBound(arr, 2)) = arr
    
20. End Sub

复制代码

全党

1. 
   

复制代码

你的代码有问题，给你改了一下

wxxydl

Sub 宏2()
    Dim arr, xD, T$, i&
    Set xD = CreateObject("scripting.dictionary")
    arr = Sheet2.[a1].CurrentRegion
    For i = 2 To UBound(arr)
        T = arr(i, 1) & "|" & arr(i, 2)
        xD(T) = arr(i, 3)
    Next
    arr = Sheet1.[a1].CurrentRegion
    For i = 2 To UBound(arr)
        T = xD(arr(i, 1) & "|" & arr(i, 3))
        If T <> "" Then
            arr(i - 1, 1) = T
        Else
            s = DateAdd("d", -1, arr(i, 1)) & "|" & arr(i, 3)
            If xD.exists(s) Then
                arr(i - 1, 1) = xD((arr(i, 1) - 1) & "|" & arr(i, 3))
            Else
                arr(i - 1, 1) = "#NA"
            End If
        End If
    Next
    Sheet1.[e2].Resize(UBound(arr) - 1, 1) = arr
End Sub

wxxydl

给你改了  附件 如下

准提部林

Sub TEST_A1()
Dim arr, xD, T$, i&
Set xD = CreateObject("scripting.dictionary")
arr = Sheet2.[a1].CurrentRegion
For i = 2 To UBound(arr)
    xD(arr(i, 1) & "|" & arr(i, 2)) = arr(i, 3)
Next
arr = Sheet1.[a1].CurrentRegion
For i = 2 To UBound(arr)
    T = xD(arr(i, 1) & "|" & arr(i, 3))
    If T = "" Then T = xD(arr(i, 1) - 1 & "|" & arr(i, 3))
    If T = "" Then T = "#NA"
    arr(i - 1, 1) = T
Next
Sheet1.[e2].Resize(UBound(arr) - 1, 1) = arr
End Sub