问VBA循环selection.find

EN

 Set cell = rngSrc.Find(sA, LookIn:=xlFormulas, LookAt:=xlPart, _
                      After:=rngSrc.Cells(rngSrc.Cells.Count), SearchOrder:=xlByRows, MatchCase:=False)
        
 If Not cell Is Nothing Then

Option Explicit

Sub macro1()

    Dim ws As Worksheet, wsBAU As Worksheet
    Dim cell As Range, rngSrc As Range
    Dim fname As String, lastrow As Long, lastrowBAU As Long
    Dim i As Long, n As Long, first As String
    Dim sA As String, sB As String
    
    fname = "Sheet1"
    
    With ThisWorkbook
        Set ws = .Sheets(fname)
        Set wsBAU = .Sheets("BAU")
    End With
    
    With ws
        lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
        Set rngSrc = .Range("A1:A" & lastrow)
    End With
    
    With wsBAU
        lastrowBAU = .Cells(.Rows.Count, "A").End(xlUp).Row
    End With
    
     With ws
        lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
        Set rngSrc = .Range("A1:A" & lastrow)
    End With
    
    ' search and replace
    Application.ScreenUpdating = False
    For i = 1 To lastrowBAU
        sA = wsBAU.Cells(i, "A")
        sB = wsBAU.Cells(i, "B")
        
        Set cell = rngSrc.Find(sA, LookIn:=xlFormulas, LookAt:=xlPart, _
                      After:=rngSrc.Cells(rngSrc.Cells.Count), SearchOrder:=xlByRows, MatchCase:=False)
        
        If Not cell Is Nothing Then
        
            first = cell.Address
            Do
                ' insert cell above
                cell.Insert xlDown
                cell.Offset(-1).Value2 = cell.Value2
                cell.Value2 = Replace(cell.Value2, sA, sB)
                ' expand search range
                n = n + 1
                Set rngSrc = ws.Range("A1:A" & lastrow + n)
                ' find next
                Set cell = rngSrc.FindNext(cell)
            Loop While cell.Address <> first
            
        End If
    Next
    Application.ScreenUpdating = True
    MsgBox n & " replacements", vbInformation
    
End Sub