<A href="?pool=0">0</TD><td>st3333</td><td></td><td>1FjPnC ... f3wkr6</td><td>Alive</td><td>494 / 5</td><td>1.00%</td><td><form name='pselect' action='status.pl' method='POST'><input type='hidden' name='swpool' value='0'><button type='submit'>Switch</button></form></td><td>1</td></tr><TR><TD class="bigger">

Function SearchInRange(oDoc, oRng, obook, l As Object) As Boolean 
Dim klop As Object, Z As Boolean 
Set klop = l 
'Задаем цикл и потом передаем параметры в функцию DoReplace 
 With oRng.Find 
 .Text = "[[]?*[]]" 
 .Forward = True 
 .Wrap = wdFindContinue 
 .Format = False 
 .MatchWildcards = True 
 .Execute 
End With 
Do While oRng.Find.Found = True 
'oRng.Find.Execute 
 If Not oRng = "" Then Codes = oRng 
 'If Not oRng = "" Then Codes = Mid(oRng, 2, Len(oRng) - 2) 
Set sRow = obook.Sheets(1).Cells.Find(What:=Codes, After:=ActiveCell, LookIn:=xlFormulas, LookAt _ 
 :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _ 
 False, SearchFormat:=False) 
If Not sRow Is Nothing Then 
 sRow = sRow.Row 
 Values = obook.Sheets(1).Range("B" & sRow).Value 
 If Len(Values) > 240 Then Values = Left(Values, 240) 
 Call DoReplace(klop:=klop, strFind:=oRng, strReplace:=Values) 
Else: 
 oRng.HighlightColorIndex = wdRed ' Заливаем проблемные коды красным 
 If Not oRng = "" Then Codes = Mid(oRng, 2, Len(oRng) - 2) 
 Values = Chr(34) & Codes & Chr(34) 
 Call DoReplace(klop:=klop, strFind:=oRng, strReplace:=Values) 
End If 
oRng.Find.Text = "[[]?*[]]" 
oRng.Find.Forward = True 
oRng.Find.Wrap = wdFindContinue 
oRng.Find.Format = False 
oRng.Find.MatchWildcards = True 
oRng.Find.Execute 
Loop 
End Function