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

1055751654

兰州0421 发表于 2020-1-7 05:26
老师，数据量也有几十万条，用2013版保存的数据，65536不够用啊

65536是好改，就是不知道你的表1跟表2是不是跟你发的表一样，在同一张表，我猜实际数据不在同一张表，那不是还得改

EXCELLMY

字典法  VBA实现将两表中信息相互匹配

lmmayc

学习学习

1055751654

兰州0421 发表于 2020-1-7 05:26
老师，数据量也有几十万条，用2013版保存的数据，65536不够用啊

Option Explicit
Sub 玩玩() '给你改成1048576吧，顺便把index也缩一缩
Dim d, arr, i%, ii%, 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 [k1048576].End(xlUp).Row
Cells(ii, "n").Resize(, 2) = Application.Index(Split(d(Cells(ii, "k").Value), "|"), [{1,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 [b1048576].End(xlUp).Row
Cells(ii, "e").Resize(, 2) = Application.Index(Split(dic(Cells(ii, "b").Value), "|"), [{1,2}])
Next
Set d = Nothing
Set dic = Nothing
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

兰州0421

谢谢老师，我运行代码，程序卡到第8行，For i = 3 To UBound(arr)

兰州0421

1055751654 发表于 2020-1-7 19:50
Option Explicit
Sub 玩玩() '给你改成1048576吧，顺便把index也缩一缩
Dim d, arr, i%, ii%, dic, arr ...

谢谢老师，我运行代码，程序卡到第8行，For i = 3 To UBound(arr)

兰州0421

y1983y 发表于 2020-1-7 09:15
借花献佛，看看是不是你要的结果

老师，表1有90万条、表2有30万条，装数据后代码执行到 第8行 For i = 3 To UBound(arr)，就卡住了。
表1有30万条、表2有30万条，装数据后代码执行到   Cells(ii, "n") = Application.Index(Split(d(Cells(ii, "k").Value), "|"), 0, 1)，又卡住了。

1055751654

兰州0421 发表于 2020-1-16 22:56
谢谢老师，我运行代码，程序卡到第8行，For i = 3 To UBound(arr)

我刚试了，没卡住呀

13583313392

兰州0421 发表于 2020-1-7 05:26
老师，数据量也有几十万条，用2013版保存的数据，65536不够用啊

改成100万就好了，几十万条，都快溢出了