For ordinate = 1 To posStr
Range("A" & ordinate).Select
mWord = ActiveCell.value
title1 = ActiveCell.Offset(0, 6).value
Range("F2").value = title1
Range("F3").value = mWord
With Worksheets(2).Range("A1:A125")
Set fcell = .Find(mWord, LookAt:=xlWhole, SearchDirection:=xlNext, MatchCase:=True)
If Not fcell Is Nothing Then
firstResult = fcell.Address
Do
cFound = fcell.Address
Range(cFound).Select
ActiveCell.Offset(0, 6).Select
title2 = ActiveCell.value
ActiveCell.Offset(0, -6).Select
If title1 = title2 Then
Selection.EntireRow.Delete
End If
Set fcell = .FindNext(fcell)
Loop While Not fcell Is Nothing And fcell.Address <> firstResult
ordinate = ordinate + 1
End If
End With
Next ordinate
Выше представлен фрагмент кода, возвращающий ошибку. В теории всё должно работать. В другом скрипте .FindNext
тоже работает в том же виде. Не могу понять, в чём моя ошибка.
Ниже вариант, в котором всё работает
For ordinate = 3 To 38
Range("F" & ordinate).Select
mWord = ActiveCell.value
With Worksheets(1).Range("G1:G10000")
Set fcell = .Find(mWord, LookAt:=xlPart, SearchDirection:=xlNext, MatchCase:=False)
If Not fcell Is Nothing Then
firstResult = fcell.Address
Do
rCopy = fcell.Row
Rows(rCopy).Select
Selection.Copy
ActiveSheet.Next.Select
Range("A1").Select
For d = 1 To 10000
If ActiveCell.value > 2 Then ActiveCell.Offset(1, 0).Select Else: Exit For
d = d + 1
Next d
ActiveSheet.Paste
ActiveSheet.Previous.Select
Set fcell = .FindNext(fcell)
Loop While Not fcell Is Nothing And fcell.Address <> firstResult
ordinate = ordinate + 1
End If
End With
Next ordinate