数据对比

zhangbuliang

向大神们求教一下，通过表一和表二中姓名对比，如果表二中在表一有的，在表二C单元中显示他在表一中的班级号。如何用VBA设计，

ykcbf1100

这个字典比较方便。。。

ykcbf1100

参与一下。。。

1. Sub ykcbf()   '//2024.9.1
   
2.     Dim arr, d
   
3.     Application.ScreenUpdating = False
   
4.     Set d = CreateObject("Scripting.Dictionary")
   
5.     With Sheets("表1")
   
6.         r = .Cells(.Rows.Count, "a").End(xlUp).Row
   
7.         arr = .[a1].Resize(r, 3)
   
8.     End With
   
9.     For i = 2 To UBound(arr)
   
10.         s = arr(i, 3)
    
11.         d(s) = arr(i, 2)
    
12.     Next
    
13.     With Sheets("表2")
    
14.         r = .Cells(.Rows.Count, "a").End(xlUp).Row
    
15.         arr = .[a1].Resize(r, 3)
    
16.         For i = 2 To UBound(arr)
    
17.             s = arr(i, 2)
    
18.             If d.Exists(s) Then arr(i, 3) = d(s) Else arr(i, 3) = ""
    
19.         Next
    
20.         .[c1].Resize(r, 1) = Application.Index(arr, 0, 3)
    
21.     End With
    
22.     Set d = Nothing
    
23.     Application.ScreenUpdating = True
    
24.     MsgBox "OK！"
    
25. End Sub
    

复制代码

quqiyuan

参与一下，仅供参考。。。

quqiyuan

代码如下。。。
Sub test()
    arr = Sheet1.[a1].CurrentRegion
    Set d = CreateObject("scripting.dictionary")
    For i = 2 To UBound(arr)
        d(arr(i, 3)) = arr(i, 2)
    Next
    arr = Sheet2.[a1].CurrentRegion
    For i = 2 To UBound(arr)
        If d.exists(arr(i, 2)) Then arr(i, 3) = d(arr(i, 2))
    Next
    Sheet2.[a1].CurrentRegion = arr
    Beep
End Sub

zhangbuliang

quqiyuan 发表于 2024-9-1 12:48
代码如下。。。
Sub test()
    arr = Sheet1.[a1].CurrentRegion

谢谢了，你太厉害了。

zhangbuliang

quqiyuan 发表于 2024-9-1 12:48
代码如下。。。
Sub test()
    arr = Sheet1.[a1].CurrentRegion

老师，能否一行一行帮忙解释一下，谢谢

renkangjizhen

arr = Sheet1.[a1].CurrentRegion

意思是把sheet1[a1]所在的数据区域收入到arr数组中

renkangjizhen

数据比对用字典法的确是首选的方法

Qs18

Sub qs()
Dim arr, i, dic
Set dic = CreateObject("scripting.dictionary")
arr = Sheet1.Range("a1").CurrentRegion.Value
For i = 2 To UBound(arr)
    s = arr(i, 3)
    If Not dic.exists(s) Then
        dic(s) = arr(i, 2)
    End If
Next
brr = Sheet2.Range("a1").CurrentRegion.Value
For i = 2 To UBound(brr)
    s = brr(i, 2)
    If dic.exists(s) Then
        brr(i, 3) = dic(s)
    End If
Next
Sheet2.Range("a1").CurrentRegion.Value = brr
Set dic = Nothing
End Sub