找高手帮助匹配EXCEL的数据

yudis98s

我现在EXCEL表格里有四张表，需要通过第四张表的B列数字ID，匹配前面三张表里面相对应的数据，自动粘贴到表四对应的数字ID后面，前面三张表，每张表分别有四十万行，整个表文件有115MB，故数据量有点大，用函数来匹配太慢，并且卡，看有没有高后帮助解决下，我现在已上传模拟数据到附加文件，麻烦哪个高手帮忙看下！

3190496160

仅就目前的数据，在我的计算机上运行，耗时0.2秒
Sub test()
Application.ScreenUpdating = False
Dim d As Object, dc As Object
Set d = CreateObject("scripting.dictionary")
Set dc = CreateObject("scripting.dictionary")
Dim i As Long
Dim s As Long
Dim br As Variant, ar As Variant
t = Timer
With ActiveSheet
    ws = .Cells(Rows.Count, 2).End(xlUp).Row
    .Range("c2:n" & ws) = Empty
    ar = .Range("b1:n" & ws)
    For i = 2 To UBound(ar)
        If Trim(ar(i, 1)) <> "" Then
            d(Trim(ar(i, 1))) = i
        End If
    Next i
    For j = 2 To UBound(ar, 2)
        If Trim(ar(1, j)) <> "" Then
            dc(Trim(ar(1, j))) = j
        End If
    Next j
    For Each sh In Sheets
        If sh.Name <> ActiveSheet.Name Then
            br = sh.[a1].CurrentRegion
            For i = 2 To UBound(br)
                If Trim(br(i, 2)) <> "" Then
                    n = d(Trim(br(i, 2)))
                    If n <> "" Then
                        For j = 3 To UBound(br, 2)
                            m = dc(Trim(br(1, j)))
                            If m <> "" Then
                                ar(n, m) = br(i, j)
                            End If
                        Next j
                    End If
                End If
            Next i
        End If
    Next sh
    .Range("b1:n" & ws) = ar
End With
Application.ScreenUpdating = True
MsgBox Format(Timer - t, "0.00")
End Sub

yudis98s

3190496160 发表于 2020-3-2 09:24
仅就目前的数据，在我的计算机上运行，耗时0.2秒
Sub test()
Application.ScreenUpdating = False

你好，这是模拟数据，前面三个表，每个表都有40万行

3190496160

yudis98s 发表于 2020-3-2 09:41
你好，这是模拟数据，前面三个表，每个表都有40万行

呵呵呵，你不会在你实际的数据中试试看看吗？？一再纠缠你的数据有多少万行

yudis98s

3190496160 发表于 2020-3-2 10:15
呵呵呵，你不会在你实际的数据中试试看看吗？？一再纠缠你的数据有多少万行

你好，我是在实际数据中匹配，提示类型不匹配，

3190496160

yudis98s 发表于 2020-3-2 10:17
你好，我是在实际数据中匹配，提示类型不匹配，

代码是没有问题的，你实际的数据中是否有错误值符号之类的，才会这样提示你，见不到你的实际文件，是能猜了

yudis98s

3190496160 发表于 2020-3-2 10:20
代码是没有问题的，你实际的数据中是否有错误值符号之类的，才会这样提示你，见不到你的实际文件，是能猜 ...

我能否加你的QQ，我发下原始数据给你，你帮我看下？

3190496160

yudis98s 发表于 2020-3-2 10:21
我能否加你的QQ，我发下原始数据给你，你帮我看下？

你已经加过我的QQ了，但是，马上就把我删了

yudis98s

3190496160 发表于 2020-3-2 10:22
你已经加过我的QQ了，但是，马上就把我删了

是吧，好像是你要我找别人，所以就删了，那好吧，还是感谢你

vic9

Sub javba()
Dim i%, j, k, d, arr, brr
Set d = CreateObject("scripting.dictionary")
brr = Sheets("4").Range("a1:l" & Sheets("4").Cells(Rows.Count, "b").End(xlUp).Row)
    For i = 1 To Sheets.Count
    arr = Sheets(i).Range("a1:l" & Sheets(i).Cells(Rows.Count, "b").End(xlUp).Row)
        If Sheets(i).Name <> "4" Then
            For j = 2 To UBound(arr)
                d(arr(j, 2)) = Array(arr(j, 3), arr(j, 4), arr(j, 5), arr(j, 6), arr(j, 7), arr(j, 8), arr(j, 9), arr(j, 10), arr(j, 11), arr(j, 12))
            Next
        End If
    Next
    For k = 2 To UBound(brr)
        Sheets("4").Cells(k, 2).Offset(0, 1).Resize(1, UBound(d(brr(k, 2))) + 1) = d(brr(k, 2))
    Next
End Sub