求助VBA实现将两表中信息相互匹配

兰州0421

两个表,想VBA实现将表一中的信息导入表二中，同时，表二中的信息导入表一中，如第三、四行的实例

由于两表相互匹配数据量达到上100万次，还请老师考虑运算时间，怎样能越快出结果。

用vlookup函数计算很慢

兰州0421

兰州0421

请老师们帮帮忙急需

1055751654

Option Explicit
Sub 玩玩()
Dim d, arr, i%, ii%, c, dic, arr1
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Set d = CreateObject("Scripting.Dictionary")
arr = [b2].CurrentRegion
    For i = 3 To UBound(arr)
        d(arr(i, 1)) = arr(i, 2) & "|" & arr(i, 3)
    Next
For ii = 3 To [k65536].End(xlUp).Row
        Cells(ii, "n") = Application.Index(Split(d(Cells(ii, "k").Value), "|"), 0, 1)
        Cells(ii, "o") = Application.Index(Split(d(Cells(ii, "k").Value), "|"), 0, 2)
    Next
Set dic = CreateObject("Scripting.Dictionary")
arr1 = [k2].CurrentRegion
    For i = 3 To UBound(arr1)
        dic(arr1(i, 1)) = arr1(i, 2) & "|" & arr1(i, 3)
    Next
For ii = 3 To [b65536].End(xlUp).Row
Cells(ii, "e") = Application.Index(Split(dic(Cells(ii, "b").Value), "|"), 0, 1)
Cells(ii, "f") = Application.Index(Split(dic(Cells(ii, "b").Value), "|"), 0, 2)
Next
Set d = Nothing
Set dic = Nothing
Application.DisplayAlerts = False
Application.ScreenUpdating = False
End Sub

1055751654

Application.ScreenUpdating = True的没改过来，我去，不改了

1055751654

改好了，有2个FOR写多了

iwangyi

Sub CC()
For Each Rng In Range("K3:K" & [K65536].End(3).Row)
Set C = Columns("B:B").Find(Rng, , , 1)
If Not C Is Nothing Then Rng.Offset(, 3).Resize(, 2) = C.Offset(, 1).Resize(, 2).Value
Next
End Sub

iwangyi

附件请参考**********

兰州0421

1055751654 发表于 2020-1-6 23:07
Application.ScreenUpdating = True的没改过来，我去，不改了

老师，数据量也有几十万条，用2013版保存的数据，65536不够用啊

y1983y

借花献佛，看看是不是你要的结果