求助各位老师

seedman

在“测试”工作表中，  以sheet2的 A列 为基础 来 和  sheet1 的A列 来比较，如果sheet2 A1在 sheet1 的A列中找到了，则 把 sheet1 相对应的“机器号”和“条形码” 填到  sheet2 的对应表格里边。


我都快疯了。2万多条记录要查找。。
多谢各位老师了。

fyure

vlookup不就可以吗
Sub aa()
Dim arr, brr
Dim i&, j&
arr = Worksheets(1).UsedRange
brr = Worksheets(2).UsedRange
For i = 1 To UBound(brr)
  For j = 1 To UBound(arr)
   If arr(i, 1) = brr(i, 1) Then
    brr(i, 2) = arr(i, 2): brr(i, 3) = arr(i, 3)
   End If
   Exit For
  Next
Next
Worksheets(2).[a1].Resize(UBound(brr), UBound(brr, 2)) = brr
End Sub

abc123281

1. Sub test1()
   
2. Dim arr
   
3. Dim ws As Worksheet
   
4. Dim d
   
5. Set d = CreateObject("scripting.dictionary")
   
6.    With Worksheets("sheet1")
   
7.       rw = .[a65536].End(xlUp).Row
   
8.       arr = .Range("a2:c" & rw)
   
9.       For i = 1 To UBound(arr)
   
10.         n = n + 1
    
11.         d(arr(i, 1)) = Array(arr(i, 2), arr(i, 3))
    
12.       Next
    
13.    End With
    
14. With Worksheets("sheet2")
    
15.     rw = .[a65536].End(xlUp).Row
    
16.     brr = .Range("a2:c" & rw)
    
17.     For i = 1 To UBound(brr)
    
18.        If d.exists(brr(i, 1)) Then
    
19.           Cells(i + 1, 2).Resize(1, 2) = d(brr(i, 1))
    
20.        End If
    
21.     Next
    
22. End With
    
23. End Sub

复制代码

abc123281

测试abc123.rar (17.65 KB, 下载次数: 2)

2018-3-30 17:13 上传

点击文件名下载附件

lsc900707

用字典处理很简单，如3楼大神的代码.