求VBA查找对应带入值！

新东写西读

求助VBA代码解决！！
用函数VLOOKUP因为：
1.数据随时增加；
2.下拉公式、或出错；
3.慢！
请求帮助

一把小刀闯天下

Option Explicit

Sub tes()
  Dim arr, dic, i
  With Sheets("资料")
    arr = .Range("a3:b" & .Cells(Rows.Count, "a").End(xlUp).Row)
  End With
  Set dic = CreateObject("scripting.dictionary")
  For i = 1 To UBound(arr, 1): dic(arr(i, 1)) = arr(i, 2): Next
  With Sheets("数据")
    arr = .Range("a3:a" & .Cells(Rows.Count, "a").End(xlUp).Row)
    For i = 1 To UBound(arr, 1)
      If Len(arr(i, 1)) > 0 Then
        If dic.exists(arr(i, 1)) Then
          arr(i, 1) = dic(arr(i, 1))
        Else
          arr(i, 1) = vbNullString
        End If
      End If
    Next
    .[e3].Resize(UBound(arr, 1), 1) = arr '可改成 .[d3]
  End With
End Sub

新东写西读

一把小刀闯天下 发表于 2018-3-20 19:11
Option Explicit

Sub tes()

非常感谢您！