VBA парсинг и импорт в столбец excel

Формулировка задачи:

Всем привет. Решил сделать парсинг сайта: https://2gis.ru/ekaterinburg/rubrics На данный момент реализовал простой вариант: Записываю в Textbox название рубрики, он открывает сайт, подставляет значение и нажимает кнопку поиск. ТУт я бы хотел автоматизовать работу, чтоб он изначально предлогал мне в виде выпадающего текста выбрать список рубрик (Combobox1), а в поле подрубрик (Combobox2) подгружались подрубрики Решил поступить так: Спарсить страницу, взять значение всех тегов стоящих между (не получается): <a class="link _scheme_none rubricsList__listItemLinkTitle"> и </a> Занести их в столбец (например начиная с B1), ну а потом при клике на Combobox1 выйдет список данных элементов (Это я знаю как реализовать) Вопрос помогите реализовать: взять значение всех тегов стоящих между (https://2gis.ru/ekaterinburg/rubrics): <a class="link _scheme_none rubricsList__listItemLinkTitle"> и </a> Занести их в столбец (например начиная с B1),

Решение задачи: «VBA парсинг и импорт в столбец excel»

textual
                            Листинг программы 
                        
 
                            
                        
Const mUrl As String = "https://2gis.ru"
Const rUrl As String = "https://2gis.ru/ekaterinburg/rubrics"
Const srUrl As String = "https://2gis.ru/ekaterinburg/subrubrics/"
 
Sub uuu()
    Dim a()
'------------
    a = GetRubrics(rUrl)
End Sub
 
Function GetRubrics(ByVal url As String) As Variant
    Dim a()
    Dim i&
    Dim t_li, t_a
'---------------------
    Set sd = CreateObject("Scripting.Dictionary")
    With CreateObject("HtmlFile")
        .Body.innerHTML = GetHtml(url)
        For Each t_li In .GetElementsByTagName("li")
            If t_li.ClassName = "rubricsList__listItem" Then
                i = i + 1
                ReDim Preserve a(1 To 3, 1 To i)
                a(1, i) = t_li.GetAttribute("data-name")
                a(2, i) = t_li.GetAttribute("data-id")
                a(3, i) = srUrl & a(2, i)
            End If
        Next
    End With
    GetRubrics = Application.Transpose(a)
End Function
 
Function GetHtml(ByVal url As String) As String
    With CreateObject("msxml2.xmlhttp")
        .Open "GET", url, False
        .send
        Do: DoEvents: Loop Until .ReadyState = 4
        GetHtml = .responsetext
    End With
End Function