Power Query + VBA №4. Обработать множество ссылок по одной

Файлы к уроку:

• Для спонсоров Boosty
• Для спонсоров VK

• YouTube
• VK

Ссылка:

• Страница курса
• Плейлист YouTube
• Плейлист ВК

Описание

На странице находится много ссылок на другие страницы.

Каждая страница, ссылка на которую находится в столбце Компания содержит таблицу с нужными нам данными.

Наша задача — это взять таблицу по каждой ссылке и склеить все эти таблицы в одну по вертикали.

Решение

В этом уроке мы изучим вариант решения этой задачи с применением VBA.

В Power Query мы создадим запрос и пользовательскую функцию, чтобы получить одну таблицу с одной страницы.

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

Примененные функции

• Table.FromColumns
• Lines.FromBinary
• Web.Contents
• Table.TransformColumns
• Text.BetweenDelimiters
• Table.SelectRows
• Text.StartsWith
• Table.TransformColumns
• Table.RenameColumns
• Web.Page
• Table.ReplaceValue
• Text.Trim
• Replacer.ReplaceValue
• Table.ExpandTableColumn
• Text.Contains
• Table.AddIndexColumn
• Table.FillDown
• Table.Pivot
• List.Distinct
• Table.RemoveColumns
• Excel.CurrentWorkbook

Код

Код для получения столбца со url страниц. Эту таблицу мы загрузим на лист Excel:

let
   source = Table.FromColumns(
      {Lines.FromBinary(Web.Contents("https://mingkh.ru/rating/moskva/moskva/"))}
   ),
   between_delimiters = Table.TransformColumns(
      source,
      {{"Column1", each Text.BetweenDelimiters(_, "a href=""/", "/"""), type text}}
   ),
   filter = Table.SelectRows(
      between_delimiters,
      each [Column1]
         <> null and [Column1]
         <> "" and Text.StartsWith([Column1], "moskva/")
   ),
   prefix = Table.TransformColumns(
      filter,
      {{"Column1", each "https://mingkh.ru/" & _, type text}}
   ),
   col_rename = Table.RenameColumns(prefix, {{"Column1", "urls"}})
in
   col_rename

Создадим пользовательскую функцию для получения одной таблицы:

(url as text) =>
   let
      url_string = url,
      read_page = Web.Page(Web.Contents(url_string)),
      filter_caption = Table.SelectRows(read_page, each ([Caption] = "Document")),
      open_data = filter_caption{0}[Data],
      html = open_data{0}[Children],
      filter_name_1 = Table.SelectRows(html, each ([Name] = "BODY")),
      open_body = filter_name_1{0}[Children],
      filter_name_2 = Table.SelectRows(open_body, each ([Name] = "DIV")),
      open_div_1 = filter_name_2{0}[Children],
      filter_name_3 = Table.SelectRows(open_div_1, each ([Name] = "DIV")),
      open_div_2 = filter_name_3{1}[Children],
      open_div_3 = open_div_2{1}[Children],
      filter_name_4 = Table.SelectRows(open_div_3, each ([Name] = "DIV")),
      open_div_4 = filter_name_4{2}[Children],
      open_div_5 = open_div_4{0}[Children],
      filter_dl = Table.SelectRows(open_div_5, each ([Name] = "DL")),
      open_dl = filter_dl{0}[Children],
      select_columns = Table.SelectColumns(open_dl, {"Name", "Children"}),
      replace_children = Table.ReplaceValue(
         select_columns,
         each [Children],
         each Table.SelectRows(
            [Children],
            each [Text] <> null and Text.Trim([Text]) <> ""
         ),
         Replacer.ReplaceValue,
         {"Children"}
      ),
      expand_children = Table.ExpandTableColumn(
         replace_children,
         "Children",
         {"Text"},
         {"Text"}
      ),
      filter_text = Table.SelectRows(
         expand_children,
         each ([Text] <> null) and not (Text.Contains([Text], "о работе УК"))
      ),
      column_index = Table.AddIndexColumn(filter_text, "Индекс", 1, 1),
      replace_index = Table.ReplaceValue(
         column_index,
         each [Индекс],
         each if Number.Mod([Индекс], 2) = 0 then null else [Индекс],
         Replacer.ReplaceValue,
         {"Индекс"}
      ),
      fill_index = Table.FillDown(replace_index, {"Индекс"}),
      pivot_name = Table.Pivot(
         fill_index,
         List.Distinct(fill_index[Name]),
         "Name",
         "Text"
      ),
      remove_columns = Table.RemoveColumns(pivot_name, {"Индекс"}),
      rename_columns = Table.RenameColumns(
         remove_columns,
         {{"DT", "Attribute"}, {"DD", "Value"}}
      ),
      url_column = Table.AddColumn(rename_columns, "URL", each url_string)
   in
      url_column

Вызов пользовательской функции:

let
    source = fn_single(Excel.CurrentWorkbook(){[Name="url"]}[Content]{0}[Column1])
in
    source

Теперь можно написать VBA-код, который будет обновлять запрос многократно и добавлять результат запроса вниз:

Sub get_tszh_data()
    
    Dim url As Range
    
    ' отключаем анимацию
    Application.ScreenUpdating = False
    
    ' цикл по таблице all_links
    For Each Item In Range("all_links[urls]")
        
        ' переходим на лист Links
        Sheets("Links").Select
        
        ' присвоение значения объектной переменной
        Set url = Range(Item.Address)
                
        ' создание именного диапазона
        Names.Add Name:="url", RefersTo:=url
        
        ' обновляем запрос
        Connections("Запрос — data_single").Refresh
        
        ' копируем таблицу с результатом запроса
        Range("data_single").Copy
        
        ' выбираем таблицу для записи результата
        Sheets("Data").Select
        
        ' переходим в последнюю строку
        Range("tszh_data[[#Headers],[Атрибут]]").End(xlDown).Select
        
        ' если строка не пустая, то переходим на одну строку ниже
        If Selection.Value <> "" Then
            Selection.Offset(1, 0).Select
        End If
        
        ' вставляем данные в таблицу
        Selection.PasteSpecial Paste:=xlPasteValues

        'Application.CutCopyMode = False
        
        ' удаляем имя
        Names("url").Delete
               
    Next Item
    
    ' включаем анимацию обратно
    Application.ScreenUpdating = True

End Sub

Курс Power Query + VBA

Номер урока	Урок	Описание
1	Power Query + VBA №1. Обновить запросы выборочно, обновить все запросы кроме одного	В этом уроке мы научимся выборочно обновлять запросы в книге Excel с помощью VBA.
2	Power Query + VBA №2. Путь к файлу папке при помощи VBA	В этом уроке вы узнаете как задать путь к файлу-источнику для Power Query при помощи VBA.
3	Power Query + VBA №3. Обработать и сохранить много файлов	В этом уроке вы узнаете как по очереди обработать и сохранить каждый нужный вам файл. Это еще один распространенный способ применения VBA в связке с Power Query.
4	Power Query + VBA №4. Обработать множество ссылок по одной	В этом уроке вы узнаете как обработать большое количество web-страниц по одной, чтобы избежать ошибок и разрывов.