问与答94：如何替换多个相同的数据并依次编号？

Sub ReplaceAndAddNum()
    Dim rngLastCell As Range
    Dim rngFoundCell As Range
    Dim strFirstAddress As String
    Dim lngCount As Long
   
    On Error Resume Next
   
    With ActiveSheet.UsedRange
        Set rngLastCell = .Cells(.Cells.Count)
        Set rngFoundCell = .Find(What:="完美Excel",_
           After:=rngLastCell, _
           LookIn:=xlValues, _
           LookAt:=xlPart, _
           SearchOrder:=xlByColumns, _
           SearchDirection:=xlNext)
        If Not rngFoundCell Is Nothing Then
           strFirstAddress = rngFoundCell.Address
           lngCount = 1
           rngFoundCell.Value = "excelperfect" & lngCount
           Do
               Set rngFoundCell = .FindNext(rngFoundCell)
               lngCount = lngCount + 1
               rngFoundCell.Value = "excelperfect" & lngCount
           Loop Until rngFoundCell.Address = strFirstAddress
        EndIf
    End With
End Sub

Sub ReplaceAndAddNumPlus()
    Dim lngCount As Long
    On Error Resume Next
    lngCount= 1
    Do
       Cells.Find("完美Excel")= "excelperfect" & lngCount
       lngCount = lngCount + 1
    Loop Until Err.Number <> 0
End Sub