Парсинг определенной информации со ссылки в ячейке

Sub A10()
Dim обязанности As String
Dim сайт As Object
ILastRow = Cells(Rows.Count, 4).End(xlUp).Row
Set сайт = CreateObject(«InternetExplorer.Application»)
сайт.Visible = True
сайт.Navigate Range("D3:D" & ILastRow)
обязанности = сайт.document.queryselector("обязаннос" Or "задачи" Or "требования").innertext
Range("E3:E" & ILastRow).Value = обязанности
End Sub

Option Explicit
 
Option Compare Text
 
Sub A97()
 
Dim s As String, st As String, r As Range, ILastRow As Integer, Arr, i As Integer, k As Long
 
ILastRow = Sheets("Анализ").Cells(Rows.Count, 8).End(xlUp).Row 'Обязанности:
 
Dim oXMLHTTP: Set oXMLHTTP = CreateObject("MSXML2.XMLHTTP") 'Теги
 
Application.DisplayAlerts = False ' Отключить вывод сообщений и оповещений во время выполнения макроса,которое у меня почему-то нихрена не работает
 
Application.ErrorCheckingOptions.BackgroundChecking = False
 
ThisWorkbook.RemovePersonalInformation = False
 
Application.EnableEvents = False
 
ThisWorkbook.EnableConnections 'Подавление сист безопасности, которое тоже нихрена не работает
 
Arr = Array("Вакансия в архиве", "обязанности:", "задачи:", "делать:", "вы будете:", "обязанностей сотрудника:")
 
For Each r In Sheets("Анализ").Range("H2:H" & ILastRow) 'ссылки
 
oXMLHTTP.Open "GET", Trim$(r), False ' Trim$(r) без пробелов в конце и начале в строке, ФОЛС для быстроты, остановит работу до возврата сервером ответа на вопрос
 
oXMLHTTP.send 'Выполняется чтение
 
On Error Resume Next 'Если возникла ошибка
 
st = DeleteTags(oXMLHTTP.responseText) 'удаляем теги и возвращаем текст ответа от сервера на отправленный запрос
 
s = "": k = 0 'Если будет ошибка, то в ячейке будет пусто
 
For i = 0 To UBound(Arr) 'возвращает значение типа Arr (у нас 6 тегов) i от 0 до 5
 
If InStr(1, st, Arr(i)) > 0 Then 'Если в 1 строке и строке st есть совпадение по Arr(i)
 
If i = 0 Then ' Срабтает ток если на сайте есть Вакансия в архиве
 
s = Arr(0) & ". " 'Типо вакансия в архиве + продолжение, а если мнененадо в ячейке вакансияв архиве, то s = & ". "
 
Else 'Если в строке нет совпадений Arr(i)
 
k = InStr(1, Split(st, Arr(i))(1), "{") - 1 ' к равно сравнение 1 строчки и чего(массива?)?, "{" - это что такое???
 
s = s & Trim$(Mid(Split(st, Arr(i))(1), 1, IIf(k > 50 And k < 500, k, 300))) 's равно s(в которой пока ничего не записано) и удалем пробелы в начале и в конце,возвращаем кол-во знаков встроке и формируемграничение текста обязанностей, от 50 до 300
 
Sheets("Анализ").Cells(r.Row, r.Column - 1) = s 'записываем в ячейку готовый ответ
 
Exit For
 
End If
 
End If
 
Next i
 
'If s = "" Then MsgBox Trim$(r)
 
Next
 
Set oXMLHTTP = Nothing
 
Application.DisplayAlerts = True
 
Application.EnableEvents = True
 
Application.ErrorCheckingOptions.BackgroundChecking = True 'возвращаем оповещения на место
 
'MsgBox "OK"
 
End Sub
 
Private Function DeleteTags(st As String) As String 'Убираем теги
 
Dim s As String
 
With CreateObject("vbscript.regexp") 'работаем с текстом и тегами
 
.Pattern = "\<.*?\>" 'шаблон заполнения тегов
 
.Global = True 'хз
 
s = .Replace(st, "") 's равно меняем ст на ""
 
st = s ' ст=""
 
.Pattern = "\\.*?\E"
 
s = .Replace(st, "")
 
End With
 
s = Replace(s, vbCrLf, " ")
 
s = Replace(s, vbCr, " ")
 
s = Replace(s, vbLf, " ")
 
s = Replace(s, vbNewLine, " ")
 
s = Replace(s, Chr(8), " ")
 
s = Replace(s, "&nbsp;", " ")
 
s = Replace(s, "&mdash;", "")
 
Do While InStr(1, s, " ") > 0
 
s = Replace(s, " ", " ")
 
Loop
 
DeleteTags = s 'короче сейчас в буфере остались теги, но их нужно удалять, и мы удаляем их из буфера, то есть с эксель ячейками мы сейчас не работаем
 
End Function