求大神帮忙，如何实现查找替换

789456luo

ykcbf1100

附件供参考。。。

ykcbf1100

查找、替换

1. Sub ykcbf()   '//2024.7.30    查找
   
2.     Application.ScreenUpdating = False
   
3.     Set d = CreateObject("Scripting.Dictionary")
   
4.     With Sheets("客户地区")
   
5.         r = .Cells(Rows.Count, 1).End(3).Row
   
6.         arr = .[a1].Resize(r, 2)
   
7.         For i = 2 To UBound(arr)
   
8.             s = arr(i, 1)
   
9.             d(s) = arr(i, 2)
   
10.         Next
    
11.     End With
    
12.     With Sheets("查找替换")
    
13.         s = .[a2]
    
14.         If d.exists(s) Then
    
15.             .[b2] = d(s)
    
16.         End If
    
17.     End With
    
18.     Set d = Nothing
    
19.     Application.ScreenUpdating = True
    
20.     MsgBox "OK！"
    
21. End Sub
    
22. 
    
23. Sub ykcbf2()   '//2024.7.30    替换
    
24.     Application.ScreenUpdating = False
    
25.     Set d = CreateObject("Scripting.Dictionary")
    
26.     With Sheets("查找替换")
    
27.         s = .[a2]
    
28.         d(s) = .[c2].Value
    
29.     End With
    
30.     With Sheets("客户地区")
    
31.         r = .Cells(Rows.Count, 1).End(3).Row
    
32.         arr = .[a1].Resize(r, 2)
    
33.         For i = 2 To UBound(arr)
    
34.             s = arr(i, 1)
    
35.             If d.exists(s) Then
    
36.                 arr(i, 2) = d(s)
    
37.             End If
    
38.         Next
    
39.         .[b1].Resize(r, 1) = Application.Index(arr, 0, 2)
    
40.     End With
    
41.     Set d = Nothing
    
42.     Application.ScreenUpdating = True
    
43.     MsgBox "OK！"
    
44. End Sub
    

复制代码

limonet

关键字：Replace

limonet

Sub limonet()
    Sheet2.Range("B2:B9999").Replace [B2], [C2]
End Sub

abc3479

1. Sub TestSub() '查找
   
2.     Set d = CreateObject("scripting.dictionary")
   
3.     Dim arr: arr = Sheet2.[a1].CurrentRegion
   
4.     For i = 2 To UBound(arr)
   
5.         If Cells(2, 1) = arr(i, 1) Then
   
6.             Cells(2, 2) = arr(i, 2)
   
7.         End If
   
8.     Next
   
9. End Sub
   
10. Sub TestSub1() '替换
    
11.     Set d = CreateObject("scripting.dictionary")
    
12.     Dim arr: arr = Sheet2.[a1].CurrentRegion
    
13.     For i = 2 To UBound(arr)
    
14.         If Cells(2, 1) = arr(i, 1) Then
    
15.             Sheet2.Cells(i, 2) = Cells(2, 3)
    
16.         End If
    
17.     Next
    
18. End Sub
    
19. 
    

复制代码

gwjkkkkk

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