求助大佬！ vba多表格匹配大数据

幽默的熊

求教家里大佬！！
sheet 2 3 4 里面B列的数据， 匹配到sheet1的C列， 其中A列为唯一匹配值
因实际数据量较大，想用vba字典数据组方式，或者大佬们知道的更高效的方式！
压缩表数据为实际数据的1/100

幽默的熊

忘了写说明， 就是想用vba字典数组方式 多表格匹配数据

幽默的熊

实例表在这里

feilanga

.............

gwjkkkkk

Option Explicit
Sub TEST6()
    Dim ar, i&, j&, dic As Object
   
    Application.ScreenUpdating = False
    Set dic = CreateObject("Scripting.Dictionary")
   
    For i = 2 To Worksheets.Count
        With Worksheets(i)
            ar = .[A1].CurrentRegion.Value
            For j = 2 To UBound(ar)
                dic(ar(j, 1)) = ar(j, 2)
            Next j
        End With
    Next i
   
    With Worksheets(1)
        With [A1].CurrentRegion
            ar = .Value
            For i = 2 To UBound(ar)
                ar(i, 3) = dic(ar(i, 1))
            Next i
            .Value = ar
        End With
        .Activate
    End With
   
    Set dic = Nothing
    Application.ScreenUpdating = True
    Beep
End Sub

gwjkkkkk

..............

幽默的熊

gwjkkkkk 发表于 2024-7-28 11:09
Option Explicit
Sub TEST6()
    Dim ar, i&, j&, dic As Object

感谢感谢 学到啦

yanglinzi

1. Sub 数据匹配()
   
2. Dim arr, brr, i, j, d
   
3. Set d = CreateObject("scripting.dictionary")
   
4. For Each sh In Sheets
   
5.     If sh.Name <> "1" Then
   
6.         arr = sh.UsedRange
   
7.         For i = 2 To UBound(arr)
   
8.             sa = arr(i, 1)
   
9.             d(sa) = arr(i, 2)
   
10.         Next
    
11.     End If
    
12. Next
    
13. With Sheet2
    
14.     r = .Cells(Rows.Count, 1).End(xlUp).Row
    
15.     brr = .Range("a1:c" & r)
    
16.     For j = 2 To UBound(arr)
    
17.         brr(j, 3) = d(brr(j, 1))
    
18.     Next
    
19. End With
    
20. Sheet2.UsedRange = brr
    
21. End Sub
    

复制代码

yanglinzi

请测试。。。

ykcbf1100

参与一下。。。