Макрос Excel для поиска веб-сайта с данными Excel и извлечения конкретных результатов, а затем зацикливаться на следующем значении

Question

Я надеюсь, что кто-то может помочь ....

У меня есть 8000 значений в таблице Excel, которые мне нужно найти на веб-сайте, а затем записать определенную строку данных с веб-сайта для ввода обратно.в таблицу Excel.

Я нашел предыдущую запись, в которой выполняется поиск данных, которые я просматриваю в макросе Excel, для поиска на веб-сайте.и извлекаем результаты

с кодом;

Sub URL_Get_ABN_Query()
    strSearch = Range("a1")
    With ActiveSheet.QueryTables.Add( _
                      Connection:="URL;http://www.abr.business.gov.au/SearchByABN.aspx?SearchText=" & strSearch & "&safe=active", _
                     Destination:=Range("a5"))

        .BackgroundQuery = True
        .TablesOnlyFromHTML = True
        .Refresh BackgroundQuery:=False
        .SaveData = True
    End With
    `enter code here`
End Sub

Однако, когда я запускаю Macro в Excel, он собирает все данные с веб-сайта следующим образом.

Я хочу только ввести строку данных типа объекта.Я искал везде и, похоже, не могу найти, как расширить код, чтобы захватить только эту строку информации и ввести в соответствующую ячейку (т. Е. Выполнить поиск ABN (b2), найти вход «тип сущности» и вставить в тип компании (c2)..

В качестве альтернативы я также попытался найти способ заставить макрос заполнять информацию по вертикали, а не по горизонтали, так как тогда я мог бы удалить ненужные столбцы, я подумал, что это может быть более простой способ запускаэтот макрос, но, увы, я снова не смог найти помощь, чтобы сделать это.Я также пытался записать макрос с разработчиком, но это тоже не сработало.

Мне также нужно зациклить его, чтобы запустить следующий ABN и заполнитьсоответствующее поле и т. д. (B3> C3, B4> C4 и т. д.).

Я хотел бы получить помощь в определении фигуры, я новичок в VBA и думаю, что я хочу сделать за пределами моего уровня навыковна этот раз. Я пытаюсь понять с помощью учебников, поисков Google и страниц справки, но не могу найти, как или если это можно сделать.

My альтернатива - сделать это вручную для каждой из 8000 точек данных, скопировав каждую abn, выполнив поиск на веб-сайте, а затем скопировав тип сущности и вставив его в Excel. Сначала я попробовал это сделать, но через некоторое время начал искать лучший способ.Можете ли вы помочь ????

Answer 1

Вы не хотите загружать соединения (queryTables), настроенные таким образом. Это будет так медленно, если вообще возможно. При 8000 запросах, при условии, что xmlhttp не заблокирован или ограничен, приведенный ниже метод будет значительно быстрее. Если кажется, что происходит замедление / блокировка, добавьте небольшое ожидание каждые x запросов.

Если возможно, используйте xmlhttp для сбора данных. Используйте css селекторы , чтобы специально нацелить тип сущности. Сохраните значения в массиве и запишите их в конце цикла. Используйте класс для хранения объекта xmlhttp для большей эффективности. Предоставьте вашему классу методы, в том числе методы обработки не найденных (приведенный пример). Добавьте некоторые дополнительные оптимизации, например дано отключение обновления экрана. Предполагается, что ваши поисковые номера в столбце B из B2. Приведенный ниже код также выполняет некоторые основные проверки того, что в столбце B есть что-то, и обрабатывает случай наличия 1 или более чисел.

Хороший код является модульным, и вы хотите, чтобы функция возвращала что-то и подпрограмма для выполнения действий. Одна подпрограмма / функция не должна выполнять множество задач. Вы хотите легко отлаживать код, который следует принципу единственная ответственность (или близок к нему).

класс clsHTTP

Option Explicit

Private http As Object  
Private Sub Class_Initialize()
    Set http = CreateObject("MSXML2.XMLHTTP")
End Sub

Public Function GetHTML(ByVal URL As String) As String
    Dim sResponse As String
    With http
        .Open "GET", URL, False
        .send
        GetHTML = StrConv(.responseBody, vbUnicode)
    End With
End Function

Public Function GetEntityType(ByVal html As HTMLDocument) As String
    On Error GoTo errhand:
     GetEntityType = html.querySelector("a[href*='EntityTypeDescription']").innerText
    Exit Function
errhand:
    GetEntityType = "Not Found"
End Function

Стандартный модуль:

Option Explicit 
Public Sub GetInfo()
    Dim http As clsHTTP, sResponse As String, lastRow As Long, groupResults(), i As Long, html As HTMLDocument
    Set html = New HTMLDocument
    Set http = New clsHTTP
    Const BASE_URL As String = "http://www.abr.business.gov.au/ABN/View/"
    Application.ScreenUpdating = False

    With ThisWorkbook.Worksheets("Sheet1")
        lastRow = .Cells(.rows.Count, "B").End(xlUp).Row
        Select Case lastRow
        Case 1
            Exit Sub
        Case 2
            ReDim arr(1, 1): arr(1, 1) = .Range("B2").Value
        Case Else
            arr = .Range("B2:B" & lastRow).Value
        End Select

        ReDim groupResults(1 To lastRow - 1)

        With http
            For i = LBound(arr, 1) To UBound(arr, 1)
                If Len(BASE_URL & arr(i, 1)) > Len(BASE_URL) Then
                    sResponse = .GetHTML(BASE_URL & arr(i, 1))
                    html.body.innerHTML = sResponse
                    groupResults(i) = .GetEntityType(html)
                    sResponse = vbNullString: html.body.innerHTML = vbNullString
                End If
            Next
        End With
        For i = LBound(groupResults) To UBound(groupResults)
            .Cells(i + 1, "C") = groupResults(i)
        Next
    End With
    Application.ScreenUpdating = True
End Sub

---

Ссылки (VBE> Инструменты> Ссылки):

1. Библиотека объектов Microsoft HTML

---

Селекторы CSS:

Я использую тот факт, что описание сущности является гиперссылкой (тег a) и что его значение содержит строку EntityTypeDescription, чтобы использовать в качестве цели атрибут css attribute = value с contains (*) для цели.

Answer 2

Это абсолютно возможно.Вы получаете то, что я часто нахожу сложнее всего, получая информацию с другой платформы.Чтобы сделать эту работу, я бы немного выделил ее и для простоты использовал 2 листа (Лист1 с вашими известными данными и Лист2 для веб-данных).

Просмотрите вашу таблицу из ~ 8000 предприятий.Мы можем определить это по количеству строк в UsedRange.Мы знаем, что ABN находится в столбце 2 (также известный как B), поэтому мы копируем его в переменную для передачи в функцию.Функция вернет «Тип сущности:» в столбец 3 (C) той же строки.

Sub LoopThroughBusinesses() 
    Dim i As Integer
    Dim ABN As String
    For i = 2 To Sheet1.UsedRange.Rows.Count
        ABN = Sheet1.Cells(i, 2)
        Sheet1.Cells(i, 3) = URL_Get_ABN_Query(ABN)
    Next i
End Sub

Измените подпрограмму, созданную вами, на функцию, чтобы она возвращала тип сущности, к которому вы стремитесь.Функция сохранит данные в Sheet2, а затем вернет только те данные Entity, которые нам нужны.

Function URL_Get_ABN_Query(strSearch As String) As String   ' Change it from a Sub to a Function that returns the desired string
    ' strSearch = Range("a1") ' This is now passed as a parameter into the Function
    Dim entityRange As Range
    With Sheet2.QueryTables.Add( _
            Connection:="URL;http://www.abr.business.gov.au/SearchByABN.aspx?SearchText=" & strSearch & "&safe=active", _
            Destination:=Sheet2.Range("A1"))   ' Change this destination to Sheet2

        .BackgroundQuery = True
        .TablesOnlyFromHTML = True
        .Refresh BackgroundQuery:=False
        .SaveData = True
    End With

    ' Find the Range that has "Entity Type:"
    Set entityRange = Sheet2.UsedRange.Find("Entity type:")

    ' Then return the value of the cell to its' right
    URL_Get_ABN_Query = entityRange.Offset(0, 1).Value2

    ' Clear Sheet2 for the next run
    Sheet2.UsedRange.Delete

End Function