Пишем автоматически обновляемую смету в Excel VBA⁠⁠

Задача: сделать смету на ремонтно-строительные работы с автоматическим обновлением цен на материалы

Решение: пишем макрос в Excel

Sub getprice()

Название макроса

Set ws = ThisWorkbook.Worksheets("список")

Присваиваем переменной ws значение листа "список" текущей рабочей книги (текущая - к которой прикреплён модуль VBA)

TotalRow = ws.UsedRange.Rows.Count

Присваиваем переменной TotalRow значение количества использованных строк листа ws

For i = 1 To TotalRow - 1

Начало цикла, начиная с 1 до количества использованных строк - 1 (-1 так как дальше мы адресуем ячейки с переменной i + 1)

TempString = "=VLOOKUP(A" & i + 1 & ",каталог!$H$1:$I$24605,2,0)"

Присваиваем переменной TempString значение формулы ВПР из листа каталог. В макросах используются только английские формулы. В формуле используется переменная, обозначающая номер строки (А1, А2 и т.д.)

ws.Cells(i + 1, 2).Formula = TempString

Заполняем ячейки, начиная с B2 листа ws значением переменной TempString

Next i

Конец цикла

Set IE = CreateObject("InternetExplorer.Application")

Присваиваем переменной IE объект InternetExplorer

For i = 1 To TotalRow - 1

Начало цикла

URL = ws.Cells(i + 1, 2).Value

Присваиваем переменной URL значение ячейки, начиная с ячейки B2 (ВПР ссылки из каталога)

IE.navigate URL

Переходим браузером по URL

Do Until (IE.readyState = 4 And Not IE.Busy)
DoEvents
Loop

Ожидаем загрузку страницы

Set ieDoc = IE.Document

Присваиваем переменной ieDoc значение HTML-кода загруженной страницы

Set detail_elements = IE.Document.getElementsByTagName("span")

Присваиваем массиву detail_elements значение массива всех элементов с тегом "span"

For Each detail_element In detail_elements

Начало цикла

If detail_element.getAttribute("class") = "retailPrice" Then

Проверка условия - равен ли атрибут элемента "class" значению "retailPrice"

ws.Cells(i + 1, 3) = detail_element.innerText

Если условие истинно, записываем внутренний текст элемента в ячейку, начиная с ячейки C2. Этот код считывает цену из интернет-каталога.

End If

Конец условия

Next detail_element

Конец цикла

Next i

Конец цикла

IE.Quit

Закрываем браузер

For i = 1 To TotalRow - 1

Начало цикла

TempString = "=VALUE(C" & i + 1 & ")"

Присваиваем переменной TempString значение формулы ЗНАЧЕН

ws.Cells(i + 1, 4).Formula = TempString

Записываем в ячейки, начиная с D2, формулу из переменной TempString

Next i

Конец цикла

MsgBox "Обновление данных завершено"

Сообщение для удобства

End Sub

Конец макроса

Источник