比对姓名，对不上的删除表2姓名行

ck03w11

说明：表1和表2姓名比对表2比对不上的删除整行该怎么写？谢谢！！！

cyq4896

参与一下..

沈默00

沈默00

试一下.....

半百

杨建营

1. Sub test()
   
2. Dim i&, j&, d
   
3. Dim arr, rng As Object
   
4. Set d = CreateObject("scripting.dictionary")
   
5. arr = Sheet1.[a1].CurrentRegion
   
6. For i = 2 To UBound(arr)
   
7. If Not d.exists(arr(i, 1)) Then
   
8. d(arr(i, 1)) = ""
   
9. End If
   
10. Next
    
11. With Sheet2
    
12. arr = .[a1].CurrentRegion
    
13. For j = 2 To UBound(arr)
    
14. If Not d.exists(arr(j, 1)) Then
    
15. If rng Is Nothing Then
    
16. Set rng = Rows(j)
    
17. Else
    
18. Set rng = Union(rng, Rows(j))
    
19. End If
    
20. End If
    
21. Next
    
22. rng.Delete
    
23. End With
    
24. End Sub

复制代码

请楼主参考。

ykcbf1100

参与一下。。。

1. Sub ykcbf()   '//2023.12.5
   
2.     Dim arr, d
   
3.     Application.ScreenUpdating = False
   
4.     Application.DisplayAlerts = False
   
5.     Set d = CreateObject("Scripting.Dictionary")
   
6.     With Sheets("正确姓名")
   
7.         r = .Cells(.Rows.Count, "a").End(xlUp).Row
   
8.         arr = .[a1].Resize(r, 1)
   
9.     End With
   
10.     For i = 2 To UBound(arr)
    
11.         s = arr(i, 1)
    
12.         d(s) = ""
    
13.     Next
    
14.     With Sheets("Sheet2")
    
15.         r = .Cells(.Rows.Count, "a").End(xlUp).Row
    
16.         arr = .[a1].Resize(r, 1)
    
17.         For i = UBound(arr) To 2 Step -1
    
18.             s = arr(i, 1)
    
19.             If Not d.Exists(s) Then
    
20.                 .Cells(i, 1).EntireRow.Delete
    
21.             End If
    
22.         Next
    
23.     End With
    
24.     Set d = Nothing
    
25.     Application.ScreenUpdating = True
    
26.     MsgBox "OK！"
    
27. End Sub

复制代码

ykcbf1100

练个手。。。。

saghj

温习一下boolean变量的用法

ck03w11

谢谢各位老师帮忙！！！