Одним из способов решения этой проблемы является вызов API, который страница использует для получения этой информации.
API возвращает json, который можно проанализировать с помощью анализатора json.Я использую jsonconverter.bas .После установки кода по этой ссылке в стандартный модуль JsonConverter, перейдите в VBE> Инструменты> Ссылки> Добавить ссылку на Microsoft Scripting Runtime.
Поиск API:
Если вы нажмете F12 , чтобы открыть инструменты разработчика, перейдите на вкладку Network, а затем нажмите F5 , чтобы обновить любой интересующий URL, вы увидите записанный веб-трафик.,Вы можете найти вызов API там.
См. Мой ответ здесь о том, как искать сетевой трафик, используя определенные наблюдениязначение, которое вы ожидаете увидеть в ответе - это отфильтрует список сетевого трафика по тем элементам, которые содержат интересующее вас значение.Будьте разумны при выборе значения - вы хотите, чтобы что-то вряд ли произошло в другом месте.Вы также можете фильтровать сетевой трафик только по XHR .
Ответ API:
API возвращает json.Более конкретно, он возвращает словарь, содержащий 2 ключа.Второй ключ, "observations", может использоваться для возврата коллекции (обозначается []) словарей (обозначается {}).Каждый словарь представляет строку таблицы (ежедневные наблюдения).Вы можете зациклить эту коллекцию, а затем зациклить внутренние словари, чтобы получить доступ к значениям строки таблицы и восстановить таблицу, заполнив массив.Изучите пример ответа json здесь .
Объяснение структуры json:
нажмите здесь доувеличить
Объяснение кода:
Код разбит на несколько вспомогательных подпрограмм ифункции, распределяя определенные задачи для каждой, чтобы упростить отладку и выполнение кода, а также лучше согласовать его с объектно-ориентированными принципами программирования.
В целом процесс выглядит так:
- Сбор URLдля
Worksheet("Sheet1").Вспомогательная функция GetAllUrls. - Обработайте эти URL и сохраните только те даты, которые соответствуют Tue-Thur.Они хранятся в виде строк, отформатированных как
"yyyymmdd", поэтому могут быть переданы в API позже.Это обрабатывается вспомогательными функциями GetOnlyQualifyingUrlsDates и IncludeThisDate.IncludeThisDate выполняет проверку на предмет включения;GetOnlyQualifyingUrlsDates обрабатывает зацикливание и форматирование результатов. - Выполняет запросы xmlhttp, циклически изменяя даты URL-адресов и объединяя их в URL-адрес для вызова API, а затем отправляет запрос.Это выполняется основной подпрограммой
GetTables. - Создание листа, для вывода, обрабатывается вспомогательной функцией
CreateWorksheet.Эта функция вызывает другую вспомогательную функцию, SheetExists, чтобы обеспечить создание листов только в том случае, если они еще не существуют, в противном случае используется существующий лист с таким именем. - Результирующий ответ json, начиная с шага 3, передается вспомогательному подпункту
WriteOutResults, который принимает переменную json и объект выходного листа в качестве аргументов.Он извлекает всю информацию из ответа json;по существу, реконструкция стола.Добавляет таблицу и заголовки на соответствующий лист.Он вызывает вспомогательную функцию Epoch2Date, которая обрабатывает метки времени unix в дату и время для двух полей unix в объекте json.
TODO:
- Ключ API может быть ограничен по времени.Добавьте вспомогательную функцию, которая возвращает текущий действующий ключ.
- API принимает параметры даты начала и окончания в конструкции url.Было бы намного лучше выполнить один запрос для всего диапазона, если это возможно, или для отдельных диапазонов, например, месяцев, чтобы уменьшить количество запросов.Это также уменьшит изменение блокировки.Это означало бы, что некоторый дополнительный код должен быть написан, прежде чем выписывать результаты, чтобы гарантировать, что на листы будут записываться только интересующие даты.Хотя вы можете выписать все, тогда просто зациклите все листы и удалите ненужные (это вполне выполнимо, если речь идет о 365 датах).Лично я бы обработал часть даты включения в построении таблицы из одного запроса (если это возможно), в котором указаны минимальные и максимальные даты для целых URL-адресов, переданных в качестве параметров начальной и конечной даты.Затем я бы записал одну простую таблицу на один лист, так как это будет намного проще для последующего анализа данных.
VBA:
Option Explicit
Public Sub GetTables()
'VBE > Tools > References > Microsoft Scripting Runtime
Dim json As Object, qualifyingUrlsDates(), urls(), url As String
Dim ws As Worksheet, wsOutput As Worksheet, i As Long, startDate As String, endDate As String
Set ws = ThisWorkbook.Worksheets("Sheet1")
urls = GetAllUrls(2, ws, "A")
qualifyingUrlsDates = GetOnlyQualifyingUrlsDates(urls)
'API key may be not be valid over time so look at obtaining by prior request
With CreateObject("MSXML2.XMLHTTP") 'issue xmlhttp request for each valid date (this would be better done using start and enddate to specify entire range _
of batches e.g. months within total range to cut down on requests
For i = LBound(qualifyingUrlsDates) To UBound(qualifyingUrlsDates)
startDate = qualifyingUrlsDates(i)
endDate = startDate ' a little verbose but useful for explaining
url = "https://api.weather.com/v1/geocode/31.76/-106.49/observations/historical.json?apiKey=6532d6454b8aa370768e63d6ba5a832e&startDate=" & startDate & "&endDate=" & endDate & "&units=e"
.Open "GET", url, False
.send
Set json = JsonConverter.ParseJson(.responseText)("observations")
Set wsOutput = CreateWorksheet(qualifyingUrlsDates(i))
WriteOutResults wsOutput, json
Next
End With
End Sub
Public Sub WriteOutResults(ByVal wsOutput As Worksheet, ByVal json As Object)
'json is a collection of dictionaries. Each dictionary is a time period reading from the day i.e. one row in output
Dim results(), item As Object, headers(), r As Long, c As Long, key As Variant
headers = json.item(1).keys 'get the headers which are the keys of each dictionary
ReDim results(1 To json.Count, 1 To UBound(headers) + 1)
For Each item In json
r = r + 1: c = 0 'increase row in results array to store results for table row
For Each key In item.keys
c = c + 1 'increase column number in results array for writing out results
Select Case key
Case "valid_time_gmt", "expire_time_gmt" 'convert unix timestamp fields to datetime
results(r, c) = Epoch2Date(item(key))
Case Else
results(r, c) = item(key)
End Select
Next
Next
With wsOutput
.Cells(1, 1).Resize(1, UBound(headers) + 1) = headers
.Cells(2, 1).Resize(UBound(results, 1), UBound(results, 2)) = results
End With
End Sub
Public Function GetOnlyQualifyingUrlsDates(ByVal urls As Variant) As Variant
Dim i As Long, output(), counter As Long
ReDim output(1 To UBound(urls))
For i = LBound(urls) To UBound(urls)
If IncludeThisDate(urls(i)) Then 'check if weekday is to be included
counter = counter + 1
output(counter) = Format$(Right$(urls(i), 8), "yyyymmdd") 'if to include then add to output array of urls of interest
End If
Next
ReDim Preserve output(1 To counter)
GetOnlyQualifyingUrlsDates = output
End Function
Public Function IncludeThisDate(ByVal url As String) As Boolean
'tue, wed, thurs are valid
IncludeThisDate = Not IsError(Application.Match(Weekday(Right$(url, 8), vbSunday), Array(3, 4, 5)))
End Function
Public Function SheetExists(ByVal sheetName As String) As Boolean '<== function by @Rory
SheetExists = Evaluate("ISREF('" & sheetName & "'!A1)")
End Function
Public Function GetAllUrls(ByVal startRow As Long, ByVal ws As Worksheet, ByVal columnName As String) As Variant
'transpose used based on premise no more than a couple of years of dates
'startRow is start row for urls, ws is sheet where urls found, columnName is string representation of column for urls e.g. "A"
With ws
GetAllUrls = Application.Transpose(ws.Range("A" & startRow & ":A" & .Cells(.rows.Count, columnName).End(xlUp).Row).Value)
End With
End Function
Public Function CreateWorksheet(ByVal sheetName As String) As Worksheet
Dim ws As Worksheet
If SheetExists(sheetName) Then
Set ws = ThisWorkbook.Worksheets(sheetName)
'do something.... clear it? Then add new data to it?
Else
Set ws = ThisWorkbook.Worksheets.Add
ws.Name = sheetName
End If
Set CreateWorksheet = ws
End Function
Public Function Epoch2Date(ByVal E As Currency, Optional msFrac) As Date '@ Schmidt http://www.vbforums.com/showthread.php?805245-EPOCH-to-Date-and-vice-versa
Const Estart As Double = #1/1/1970#
msFrac = 0
If E > 10000000000@ Then E = E * 0.001: msFrac = E - Int(E)
Epoch2Date = Estart + (E - msFrac) / 86400
End Function