Всем доброго времени суток!
На неком сайте ежемесячно выкладывается файл (Пример 04 НН, 09 Ярославль, 10 Ростов), который формируется ссылкой, где меняется лишь код региона и дата. В этом файле есть столбец с датами по дням и пиковыми часами. Количество дней ежемесячно может быть разное, столбец "Фактический час может отсутствовать".
И есть таблица (Пример "Часы пик", в шапке в 1 строке регион, 2 строка код региона(из файла с сайта), 3 строка название столбца из файла с сайта(названия совпадают). И в первом столбце месяцы.
Нужно сделать так, чтобы при выборе даты на листе "Worksheet" и запуске макроса, поочередно по кодам региона открывались файлы с сайта, и дата и пиковые часы из столбцов с нужными названиями копировались в таблицу, в нужные регионы и даты.
Сейчас я добился того что файл находится и скачивается через раз, через раз копируется столбик с датой, но в основном выходит ошибка Runtime 1004 "имя не найдено или совпадает с чем-то".
Проблема еще в том что в файле с сайта количество дней с пиковыми часами каждый месяц могут быть разные, конкретный диапазон копирования указать не получится, может захватить лишнего.
И столбец "фактический час может отсутствовать".
Примеры во вложении.
Помогите пожалуйста дописать код!
| Код |
|---|
Sub Загрузка_часов() 'Объявляем переменные
Dim URL As String, DestinationFile As String
Dim C As Integer 'для столбика
Dim R As Integer 'для строки
Dim yy As Integer
Dim mm As Integer
Dim code As String
Application.ScreenUpdating = False 'отключаем обновление экрана
R = Лист4.[A6] 'Определяем номер строки с гиперссылками по которым нужно заполнить
yy = Лист4.[A1] 'Год
mm = Лист4.[A2] 'Месяц
code1 = Cells(2, 2) 'код региона с сайта
Workbooks.Open Filename:= _
"http://elira.pro/Forecast/DownloadForecastFile/"; & "/" & code1 & "/" & yy & "/" & mm & "?type=2"
Range("B7:B29").Copy
ActiveWindow.Close
Cells(R + 1, 1).Select
ActiveSheet.Paste
For C = 2 To 37 Step 4 'цикл по столбикам в установленном диапазоне в каждом 4 столбике
code2 = Cells(2, C)
Workbooks.Open Filename:= _
"http://elira.pro/Forecast/DownloadForecastFile/"; & "/" & code2 & "/" & yy & "/" & mm & "?type=2"
Range("C7:E29").Copy
ActiveWindow.Close
Cells(R + 1, C + 1).Select
ActiveSheet.Paste
Next 'следующая ячейка установленного диапазона
Application.ScreenUpdating = True 'включаем обновление экрана
MsgBox "Загрузка пиковых часов за " & Лист4.[A11] & " " & Лист4.[D11] & " успешно завершена!", vbInformation
End Sub |
